[英]Export from Excel to Access 2007 using Excel VBA
I need to export the contents of a worksheet to append to an access database table (both 2007)and I am attempting to run this from a module in the Excel spreadsheet. 我需要导出工作表的内容以附加到Access数据库表(均为2007年),并且我试图从Excel电子表格中的模块运行它。 The table has a primary key which is an autonumber and I have tried running the module below with and without an empty first column in the spreadsheet to match the spreadsheet columns with the table columns. 该表具有一个主键,该主键是一个自动编号,我尝试在电子表格中的第一列为空且没有空的情况下运行以下模块,以使电子表格列与表格列匹配。 Also the final field in the table is a checkbox Y\\N and I have made the final column in the spreadsheet TRUE and FALSE values. 此外,表中的最后一个字段是复选框Y \\ N,我已将电子表格的最后一列设为TRUE和FALSE值。 But when I run the module I get the "Finished" msgbox but the table is not updated. 但是,当我运行模块时,我得到了“已完成”的消息框,但表未更新。 Both the spreadsheet and the database are in the location of C:. 电子表格和数据库都位于C:的位置。 What am I doing wrong? 我究竟做错了什么?
Private Sub AddData()
Dim strMyPath As String, strDBName As String, strDB As String, strSQL
As String
Dim i As Long, n As Long, lastRow As Long, lFieldCount As Long
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection
strDBName = "CMDB.mdb"
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\" & strDBName
"Microsoft.ACE.OLEDB.12.0". The ACE Provider can be used for both the
Access .mdb & .accdb files.
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0;
data source=" & strDB
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(18)
Set adoRecSet = New ADODB.Recordset
strTable = "Asset_Table"
adoRecSet.Open Source:=strTable, ActiveConnection:=connDB,
CursorType:=adOpenStatic, LockType:=adLockOptimistic
lFieldCount = adoRecSet.Fields.Count
'determine last data row in the worksheet:
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
adoRecSet.AddNew
For n = 0 To lFieldCount - 1
adoRecSet.Fields(n).Value = ws.Cells(i, n + 1)
Next n
adoRecSet.Update
Next i
adoRecSet.Close
connDB.Close
Set adoRecSet = Nothing
Set connDB = Nothing
MsgBox "Finished"
End Sub
EDIT: The advice of Evans and ChipsLetten below assisted and I have this resolved. 编辑:下面的Evans和ChipsLetten的建议得到了帮助,我已经解决了。 I changed the row count calculation and added in an If to deal with the auto number as Chips suggested to be the following. 我更改了行计数计算,并添加了一个If以处理自动编号,因为Chips建议如下。
Dim b As Long
b = ws.UsedRange.Rows.Count
For i = 2 To b - 1
adoRecSet.AddNew
For n = 0 To lFieldCount - 1
If Not adoRecSet.Fields(n).Properties("ISAUTOINCREMENT") Then
adoRecSet.Fields(n).Value = ws.Cells(i, n + 1).Value
End If
Next n
adoRecSet.Update
Next i
You can test the field to see if it is an auto increment field before trying to write a value to it. 您可以在尝试向该字段写入值之前对其进行测试,以查看其是否为自动递增字段。 Try the below code which works ok for me (Excel 2007 but Access 2010) 尝试下面的代码对我来说可以正常使用(Excel 2007但Access 2010)
For i = 2 To lastRow
adoRecSet.AddNew
For n = 0 To lFieldCount - 1
If Not adoRecSet.Fields(n).Properties("ISAUTOINCREMENT") Then
adoRecSet.Fields(n).Value = ws.Cells(i, n + 1).Value
End If
Next n
adoRecSet.Update
Next i
Using TRUE/FALSE for the final column of the Excel sheet works fine for me. 对Excel工作表的最后一列使用TRUE / FALSE对我来说很好。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.