从MS Access更新Excel

Question

我尝试使用此link中的代码在Excel和Access之间推送和检索数据。我根据文件路径修改了代码，如下所示：

编辑新代码块

Sub UpdateMDB()
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long

lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row

accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"

Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")

accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If

Do While Not accRST.EOF
For i = 1 To lastrow
    If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
            And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i) Then
       accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i)
    End If
Next i
accRST.Update
accRST.MoveNext
Loop

accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing

End Sub

INITIAL CODE BLOCK

Sub GetMDB()
Dim cn As Object
Dim rs As Object

strFile = "Z:\Documents\Database\Database1.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM Table1"
rs.Open strSQL, cn

With Worksheets(1)
For i = 0 To rs.Fields.Count - 1
    .Cells(1, i + 1) = rs.Fields(i).Name
Next

rs.MoveFirst
.Cells(2, 1).CopyFromRecordset rs
End With
End Sub

Sub UpdateMDB()
Dim cn As Object
Dim rs As Object

''It would probably be better to use the proper name, but this is
''convenient for notes
 strFile = Workbooks(1).FullName

''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns
 strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
 Set cn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
 cn.Open strCon

''Selecting the cell that are different
 strSQL = "SELECT * FROM [Sheet1$] s " _
& "INNER JOIN [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "ON s.id=t.id " _
& "WHERE s.Field1<>t.Field1"
rs.Open strSQL, cn, 1, 3 ''adOpenKeyset, adLockOptimistic

''Just to see
''If Not rs.EOF Then MsgBox rs.GetString

''Editing one by one (slow)
rs.MoveFirst
Do While Not rs.EOF
rs.Fields("t.Field1") = rs.Fields("s.Field1")
rs.Update
rs.MoveNext
Loop

''Batch update (faster)
strSQL = "UPDATE [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "INNER JOIN [Sheet1$] s " _
& "ON s.id=t.id " _
& "SET t.Field1=s.Field1 " _
& "WHERE s.Field1<>t.Field1 "

cn.Execute strSQL
End Sub

从Access to Excel GetMDB()宏中读取数据工作正常，但当我尝试将数据从Excel更新为Access时，代码会出现以下错误：

Run-time error '3021':
Either BOF or EOF is True, or the current record has been deleted. 
Requested operation requires a current record.

我检查了mdb，xlsx和工作表路径，并且名称是正确的。任何人都有类似的问题，如何克服？谢谢。

Answer 1

您无法使用Excel工作簿源运行UPDATE个查询，因为使用工作簿的任何SQL查询都是从上次保存的实例中读取的，无法更新。 Excel根本不是用于执行此类事务的数据库，没有记录级锁定机制，读/写访问或关系模型。虽然您可以运行追加（INSERT INTO ... SELECT *）和生成表查询（SELECT * INTO FROM ...），但您无法运行与实时值对齐的UPDATE。

但是，您可以读取Access记录集并迭代Excel单元格，通过ID匹配进行对齐。下面假设Excel Sheet的 ID 列在A列中， Field1 在B列中。

Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512

lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row

accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"

Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")

accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
    accRST.MoveFirst
Else
    Msgbox "No records in Access table.", vbInformation
    accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
    Exit Sub
End If

Do While Not accRST.EOF
    For i = 1 to lastrow
        If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
                And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i)  Then 
           accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i) 
        End If
    Next i
    accRST.Update
    accRST.MoveNext
Loop 

accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing

注意：

1. 如果Excel工作表和Access表之间的ID不是一对一的（即，Excel有多行相同的 ID ），则最后的 Field1 If逻辑后面的值将插入相应的Access行。

2. 如果数据库行和Excel单元格很大，则上面可能会进行大量处理。最好的选择就是使用Access进行所有数据输入/管理并避免更新需求。由于Excel是一个平面文件，因此请考虑将其用作最终用途应用程序，将Access用作中央数据存储库。