问如何使用excel power query更新MS Access数据库？

EN

Sub ImportFromAccess()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\your_path_here\Northwind.mdb"

   Set myRecordset = New ADODB.Recordset

   FocusRow = ActiveCell.Row
   With myRecordset
       .Open "SELECT * FROM PersonInformation WHERE ID=" & Worksheets("Sheet1").Range("A2").Value, _
         strConn, adOpenKeyset, adLockOptimistic
         ' This assumes that ID is a number field. If it is a text field, use
         ' .Open "SELECT * FROM PersonInformation WHERE ID='" & Worksheets("Sheet1").Range("A2").Value & "'", _
         strConn, adOpenKeyset, adLockOptimistic

      .Fields("ID").Value = Worksheets("Sheet1").Range("A" & FocusRow).Value
      .Fields("FName").Value = Worksheets("Sheet1").Range("B" & FocusRow).Value
      .Fields("LName").Value = Worksheets("Sheet1").Range("C" & FocusRow).Value
      .Fields("Address").Value = Worksheets("Sheet1").Range("D" & FocusRow).Value
      .Fields("Age").Value = Worksheets("Sheet1").Range("E" & FocusRow).Value
      .Update
      .Close
   End With
   Set myRecordset = Nothing
   Set conn = Nothing
End Sub

Sub UpdateRecordsInAccess()
    Dim rng As Range
    Dim r As Long
    Dim conn As ADODB.Connection
    Dim strConn As String
    Dim strSQL As String

    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        "C:\your_path_here\Northwind.mdb"
    Set conn = New ADODB.Connection
    conn.Open strConn

    With Worksheets("Sheet1")
        lastrow = .Range("A2").End(xlDown).Row
        lastcolumn = .Range("A2").End(xlToRight).Column
        Set rng = .Range(.Cells(lastrow, 1), .Cells(lastrow, lastcolumn))
    End With

        'therow = 1

        For i = 2 To lastrow
            'r = rng.Row
            'If r > 1 Then
                strSQL = "UPDATE PersonInformation SET " & _
                    "FName='" & Worksheets("Sheet1").Range("B" & i).Value & "', " & _
                    "LName='" & Worksheets("Sheet1").Range("C" & i).Value & "', " & _
                    "Address='" & Worksheets("Sheet1").Range("D" & i).Value & "', " & _
                    "Age=" & Worksheets("Sheet1").Range("E" & i).Value & " WHERE " & _
                    "ID=" & Worksheets("Sheet1").Range("A" & i).Value
                conn.Execute strSQL
            'End If
            'r = r + 1
        Next i


    conn.Close
    Set conn = Nothing
End Sub

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data  Source=C:\Users\username\Desktop\DatabaseResplann.mdb;"
Set conn = New ADODB.Connection
conn.Open strConn


With Worksheets("Sheet1")
    lastrow = .Range("A2").End(xlDown).Row
    lastcolumn = .Range("A2").End(xlToRight).Column
    Set rng = .Range(.Cells(lastrow, 1), .Cells(lastrow, lastcolumn))
End With

    'therow = 1

    For i = 2 To lastrow
        'r = rng.Row
        'If r > 1 Then
            strSQL = "UPDATE Allocation SET " & _
                "Resource Name='" & Worksheets("Sheet1").Range("B" & i).Value & "', " & _
                "Child PID='" & Worksheets("Sheet1").Range("C" & i).Value & "', " & _
                "Fct wk#='" & Worksheets("Sheet1").Range("D" & i).Value & "', " & _
                "Fct Hrs='" & Worksheets("Sheet1").Range("E" & i).Value & "', " & _
                "Fct %='" & Worksheets("Sheet1").Range("F" & i).Value & "', " & _
                "Comment='" & Worksheets("Sheet1").Range("G" & i).Value & " WHERE " & _
                "Resource ID='" & Worksheets("Sheet1").Range("A" & i).Value
            conn.Execute strSQL
        'End If
        'r = r + 1
    Next i


conn.Close
Set conn = Nothing