将 Excel 表导入 Access 表？

Question

我正在尝试将 excel 中的指定表导入 Access。一旦用户将 Excel 电子表格中的数据转换为表格，我就知道数据应该是干净的，没有子标题和合并的单元格。但是，在使用 Sub

'''

 Public Sub ImportExcelSpreadsheet(FileName As String, tableName As String, Range As String)
 
 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, tableName, FileName, True, Range

 End Sub
 

 'When I try to run the sub the values are as follows
 ExcelImport.ImportExcelSpreadsheet Me.txtFileName, FSO.GetFileName(Me.txtFileName), "tbl_IOList[#All]" 'Where tbl_IOList[#All] is the range

我在输入范围为“$A$1:$L$116”时已经成功，但它不适用于“tbl_IOList[#All]”

Answer 1

您当然可以将数据从 Access 插入 Excel。试试下面的代码反馈。

Sub InsertInto()

    Dim cn As ADODB.Connection, rs As ADODB.Recordset, row As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
            "Data Source=C:\your_path\Test.accdb;"

    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "tblYourTable", cn, adOpenKeyset, adLockOptimistic, adCmdTable

    row = 3    ' the start row in the worksheet
    Do While Not IsEmpty(Worksheets("Sheet1").Range("A" & row))

        With rs
            .AddNew    ' create a new record
            .Fields("ID") = Worksheets("Sheet1").Range("A" & row).Value
            .Fields("Product") = Worksheets("Sheet1").Range("B" & row).Value
            .Fields("ProdDate") = Worksheets("Sheet1").Range("C" & row).Value
            .Update
        End With
        row = row + 1
    Loop

    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

这在 Excel 中运行，并将数据推送到 MS Access。如果您想从 Access 运行该过程，并从 Excel 导入，您可以尝试这样做。

Sub ImportDataFromExcel()
    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\Test.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