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

时间:2018-01-28 14:00:40

标签: excel-vba ms-access vba excel

我需要一点帮助。我有一个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

1 个答案:

答案 0 :(得分:0)

您的代码似乎有点修复。

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