|
楼主 |
发表于 2013-10-14 16:02
|
显示全部楼层
Sub nrb() '单据号自动编码
Dim mydata As String, mytable As String, sql As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim ii As Integer
Dim myarray As Variant
Dim rng As Range
mydata = ThisWorkbook.Path & "\MCL.mdb"
mytable = "ruku"
Set rng = Range("d2")
Set cnn = New ADODB.Connection
With cnn
.Provider = "microsoft.jet.oledb.4.0"
.Open mydata
End With
sql = "select distinct 文件号 from ruku "
Set rs = New ADODB.Recordset
rs.Open sql, cnn, 3, adLockOptimistic
If rs.RecordCount <> 0 Then
rs.MoveFirst
Do While rs.EOF = False
trs = rs.Fields("文件号")
dt = Mid(trs, 7, 8)
If dt = Format(Date, "yyyymmdd") Then
i = Val(Right(trs, Len(trs) - InStr(trs, "-")))
rng.Value = "XMIN R" & Format(Date, "yyyymmdd") & "-" & Format(i + 1, "00") '会出现 Else
rng.Value = "XMIN R" & Format(Date, "yyyymmdd") & "-" & Format(1, "00") '会出现 End If
rs.MoveNext
Loop
Else
rng.Value = "XMIN R" & Format(Date, "yyyymmdd") & "-" & Format(1, "00")End If
rs.Close
cnn.Close
Set rs = Nothing
Set cnn
end sub
红色字体会出现错误提示,就是有用到VALUE都会提示! |
|