将Excel表导入Access表?

Question

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

时"

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_pathTest.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_pathTest.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