我正在创建一个 Excel 表单,其中我的数据库是 MS Access。
首先,我在 Excel 中对数据进行编码,然后使用命令按钮发布此数据。
命令按钮内的代码:首先从Access中获取最大数字,并使用该数字完成Excel中的数据导出到Access。问题是如果我使用 2 个及以上用户同时发布,它会将所有数据合并为一个具有相同数量的数据。
我想要的是锁定打开的数据直到发布,因为我需要获取列的最大编号,然后先添加 1,然后导入一组完整的数据,包括最大编号作为控制编号。
我尝试使用 Do While adStateOpen <> 1 和 Do While IsRecordBusy = True 然后等待并循环并将记录集设置为空,而不是关闭它两次。但它不会工作,它将合并具有相同控制编号的数据。
这是我的代码:
Option Explicit
Sub ImportJEData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
Dim nextrow As Long
Dim Var
Dim LockType
Dim SQL
Dim IsRecordBusy
'add error handling
On Error GoTo errHandler:
'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set Var = Sheets("JE FORM").Range("F14")
nextrow = Sheets("LEDGERTEMPFORM").Cells(Rows.Count - 5, 1).End(xlUp).Row
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Create the ADODB recordset object. for Max Number
Set rst = New ADODB.Recordset 'assign memory to the recordset
LockType = adLockPessimistic
'Do While adStateOpen <> 1
Do While IsRecordBusy = True
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Loop
SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "
rst.Open SQL, cnn
Sheets("Max").Range("A2").CopyFromRecordset rst
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.Open Source:="DV", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockPessimistic, _
Options:=adCmdTable
On Error Resume Next
'you now have the recordset object
'add the values to it
For x = 7 To nextrow
rst.AddNew
For i = 1 To 37
rst(Sheets("LEDGERTEMPFORM").Cells(6, i).Value) = Sheets("LEDGERTEMPFORM").Cells(x, i).Value
Next i
rst.Update
Next x
'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing
'Update the sheet
Application.ScreenUpdating = True
'Clear the data
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
我终于完成了这段代码。我刚刚在 access 中添加了另一个表,其中该表是唯一的,使用 sql 来获取 max+1 并将其插入回来,如果由于重复而发生错误,则将其循环。下面是代码
Do
On Error Resume Next 'reset Err.obj.
'Get the Max ID +1
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
rst.Open SQL, cnn
'Check if the recordset is empty.
'Copy Recordset to the Temporary Cell
Sheets("MAX").Range("A2").CopyFromRecordset rst
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
cnn.Execute Sql2
Loop Until (Err.Number = 0)
希望这对 Excel Front 用户有所帮助。