前端 Excel 和后端访问更新数据

Question

我需要一点帮助。我有一个 Access 文件名"DB_MLL.accdb"，表名"tblMLL"总共 31 列，包括主键。我正在使用前端 Excel 和后端访问来获取数据。我有两个按钮可以从 Acess 中提取数据并推送回访问。从访问中提取数据工作正常，但回推不起作用。我正在使用以下代码。请你指导我做错的地方。

Sub PushTableToAccess()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Variant, j As Variant
Dim Rw As Long
Sheets("Data").Activate
Rw = Range("A65536").End(xlUp).Row
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="tblMLL", ActiveConnection:=cnn, _
         CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
         Options:=adCmdTable
'Load all records from Excel to Access.
For i = 3 To Rw
    rst.AddNew
    For j = 1 To 31
    If Cells(i, j).Value = "" Then
        rst(Cells(2, j).Value) = ""
        Else
        rst(Cells(2, j).Value) = Cells(i, j).Value
    End If
    Next j
    rst.Update
Next i
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
MsgBox "Data Upload Completed successfully."
End Sub

Answer 1

您的代码似乎有一些修复。

Sub PushTableToAccess()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
    Dim i As Variant, j As Variant
    Dim Rw As Long
    Dim strConn As String
    Sheets("Data").Activate
    Rw = Range("A65536").End(xlUp).Row
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & MyConn
    cnn.Open strConn
    Set rst = New ADODB.Recordset
    wirh rst
        .CursorLocation = adUseServer
        .Source = "tblMLL"
        .Options = adCmdTable
        .ActiveConnection = strConn
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open

    'Load all records from Excel to Access.
        For i = 3 To Rw
            .AddNew
            For j = 1 To 31
                If Cells(i, j).Value = "" Then
                    .Fields(Cells(2, j).Value) = ""
                    Else
                    .Fields(Cells(2, j).Value) = Cells(i, j).Value
                End If
            Next j
            .Update
        Next i
    End With
    ' Close the connection
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    MsgBox "Data Upload Completed successfully."
End Sub