从 MS Access 更新 Excel

Question

I tried the code in this 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

初始代码块

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 读取数据到 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 和 sheet 路径和名称是否正确。任何人也有类似的问题以及如何克服？谢谢。

Answer 1

您不能使用 Excel 工作簿源进行运行 UPDATE 查询，因为使用工作簿的任何 SQL 查询对于上次保存的实例都是只读的，无法更新。 Excel 根本不是一个没有记录级锁定机制、read/write 访问或关系模型来执行此类事务的数据库。尽管您可以运行追加 (INSERT INTO ... SELECT *) 并进行 table 查询 (SELECT * INTO FROM ...)，但您不能运行 UPDATE 与实时值对齐.

但是，您可以读取 Access 记录集并遍历按 ID 匹配对齐的 Excel 单元格。下面假设 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

备注：

如果 Excel 工作表和 Access table 之间的 ID 不是一对一的（即 Excel 有多行相同的 ID), Field1 逻辑后面的最后一个 Field1 值将被插入到相应的访问行。
如果数据库行和 Excel 单元格很大，以上可能是大量处理。最好的选择是简单地对所有数据使用 Access entry/management 并避免更新需求。由于 Excel 是平面文件，请考虑将其用作最终用途应用程序并将 Access 用作中央数据存储库。

从 MS Access 更新 Excel

Update Excel from MS Access

excel

ms-access

vba

ms-access-2010