使用VBA将数据从Excel导出到Access [英] Export data from Excel to Access using VBA
问题描述
目前我有这个代码，但它不工作...
Sub Button14_Click（）
'宏目的：使用ADO和SQL
'向Access数据库添加记录注意： ActiveX数据对象需要Libary
'将活动工作表中的数据导出到Access数据库中的表
'Dim cnt As New ADODB.Connection
'Dim rst作为新的ADODB.Recordset
Dim cnt As DAO.Database
Dim rst As Recordset
Dim dbPath As String
Dim tblName As String
Dim rngColHeads As Range
Dim rngTblRcds As Range
Dim colHead As String
Dim rcdDetail As String
Dim ch As Integer
Dim cl As Integer
Dim notNul l As Boolean
Dim sConnect As String
'将字符串设置为工作表上定义的数据库路径
dbPath =C：\Documents and Settings\ Administrador\Mis documentos\MonEAU\modelEAU数据库V.2.accdb
tblName =水质
设置rngColHeads = ActiveSheet.Range（tblHeadings）
设置rngTblRcds = ActiveSheet.Range（tblRecords）
'设置数据库连接字符串
sConnect =Provider = Microsoft.ACE.OLEDB.12.0; Data Source ='& dbPath& ; '用于* .accdb文件
'sConnect =Provider = Microsoft.Jet.OLEDB.4.0; Data Source =& dbPath& ; '用于* .mdb文件
'将列标题的名称连接到一个字符串
colHead =（
对于ch = 1 To rngColHeads.Count
colHead = colHead& rngColHeads.Columns（ch）.Value
选择案例ch
案例Is = rngColHeads.Count
colHead = colHead&）
案例Else
colHead = colHead& ，
结束选择
下一步ch
'打开与数据库的连接
cnt.Open sConnect
'开始事务处理
On错误GoTo EndUpdate
cnt.BeginTrans
'从工作表中将记录插入到表
对于cl = 1到rngTblRcds.Rows.Count
'假设记录完全为空，并打开记录字符串连接
notNull = False
rcdDetail =（'
'评估记录中的字段
对于ch = 1到rngColHeads.Count
选择案例rngTblRcds.Rows（cl）.Columns（ch）.Value
'如果为空，将值为null添加到字符串
案例Is =空
选择case ch
Case Is = rngColHeads.Count
rcdDetail = Left（rcdDetail，Len（rcdDetail） - 1）&NULL）
Case Else
rcdDetail = Left（rcdDetail ，Len（rcdDetail） - 1）& NULL，
End选择
'如果不为空，将notNull设置为true，并将值附加到字符串
Case Else
notNull = True
选择案例ch
案例Is = rngColHeads.Count
rcdDetail = rcdDetail& rngTblRcds.Rows（cl）.Columns（ch）.Value& '）
Case Else
rcdDetail = rcdDetail& rngTblRcds.Rows（cl）.Columns（ch）.Value& '，'
结束选择
结束选择
下一步ch
'如果记录仅包含Null值，请勿将其插入到表中，否则
'插入记录
选择Case notNull
Case Is = True
rst.OpenINSERT INTO& tblName& colHead& VALUES& rcdDetail，cnt
案例Is = False
'不插入记录
结束选择
下一个cl
EndUpdate：
'检查是否错误被列入
如果Err.Number<> 0然后
'遇到错误。回滚事务并通知用户
On Error Resume Next
cnt.RollbackTrans
MsgBox有错误，更新没有成功！，vbCritical，Error！
Else
错误简历Next
cnt.CommitTrans
如果
'关闭ADO对象
cnt.Close
设置rst = Nothing
设置cnt =没有
错误GoTo 0
End Sub
目前，问题是我调试代码时出现编译错误：方法或数据成员未找到的函数cnt.Open sConnect。
如果可能，任何帮助将不胜感激。
注意：我正在使用Office 2010。 >
您的编译错误是由于这两行：
Dim cnt As DAO.Database
cnt.Open sConnect
A DAO.Database 对象没有 .Open 方法，这解释了未找到方法或数据成员。错误消息往往有些模糊，只是不是很有帮助。但是，在这种情况下，我无法想到错误信息可能会更清楚。
有更多的东西我不明白。 sConnect 看起来像ADO连接字符串。但是 cnt 是一个 DAO （数据库）对象。你不能在一个语句中混搭这样的两个对象模型。
你刚刚在你的活动变量声明之前：
'Dim cnt As New ADODB.Connection
然后在你的程序中，你有：
'关闭ADO对象
cnt.Close
所以也许你原本打算 cnt 成为一个 ADO.Connection 对象，并且在将其切换到 DAO.Database 对象后，并没有调整其余的代码。
我建议您修改代码以整理DAO与ADO混淆，然后向我们显示新代码（如果有其他问题）。并且只能向我们显示重现您希望解决的问题所需的最低测试代码。 TIA供您考虑。
I have a table in an Excel file with some data, and I want to export these data to my database on Access (in a concrete table on my database called Water Quality) with a VBA code to avoid to open my Database every time that I want to introduce more data on it.
At the moment I have this code but it's not working...
Sub Button14_Click()
' Macro purpose: To add record to Access database using ADO and SQL
' NOTE: Reference to Microsoft ActiveX Data Objects Libary required
' Exports data from the active worksheet to a table in an Access database
'Dim cnt As New ADODB.Connection
'Dim rst As New ADODB.Recordset
Dim cnt As DAO.Database
Dim rst As Recordset
Dim dbPath As String
Dim tblName As String
Dim rngColHeads As Range
Dim rngTblRcds As Range
Dim colHead As String
Dim rcdDetail As String
Dim ch As Integer
Dim cl As Integer
Dim notNull As Boolean
Dim sConnect As String
'Set the string to the path of your database as defined on the worksheet
dbPath = "C:\Documents and Settings\Administrador\Mis documentos\MonEAU\modelEAU Database V.2.accdb"
tblName = "Water Quality"
Set rngColHeads = ActiveSheet.Range("tblHeadings")
Set rngTblRcds = ActiveSheet.Range("tblRecords")
'Set the database connection string here
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & dbPath & "';" 'For use with *.accdb files
' sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";" 'For use with *.mdb files
'Concatenate a string with the names of the column headings
colHead = " ("
For ch = 1 To rngColHeads.Count
colHead = colHead & rngColHeads.Columns(ch).Value
Select Case ch
Case Is = rngColHeads.Count
colHead = colHead & ")"
Case Else
colHead = colHead & ","
End Select
Next ch
'Open connection to the database
cnt.Open sConnect
'Begin transaction processing
On Error GoTo EndUpdate
cnt.BeginTrans
'Insert records into database from worksheet table
For cl = 1 To rngTblRcds.Rows.Count
'Assume record is completely Null, and open record string for concatenation
notNull = False
rcdDetail = "('"
'Evaluate field in the record
For ch = 1 To rngColHeads.Count
Select Case rngTblRcds.Rows(cl).Columns(ch).Value
'if empty, append value of null to string
Case Is = Empty
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
Case Else
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
End Select
'if not empty, set notNull to true, and append value to string
Case Else
notNull = True
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
Case Else
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
End Select
End Select
Next ch
'If record consists of only Null values, do not insert it to table, otherwise
'insert the record
Select Case notNull
Case Is = True
rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt
Case Is = False
'do not insert record
End Select
Next cl
EndUpdate:
'Check if error was encounted
If Err.Number <> 0 Then
'Error encountered. Rollback transaction and inform user
On Error Resume Next
cnt.RollbackTrans
MsgBox "There was an error. Update was not succesful!", vbCritical, "Error!"
Else
On Error Resume Next
cnt.CommitTrans
End If
'Close the ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub
At the moment, the problem is when I debug the code, there appears the compiling error: "Method or data member not found" on the function "cnt.Open sConnect".
If this is possible, any help would be greatly appreciated.
Note: I'm using Office 2010.
Your compile error is due to these 2 lines:
Dim cnt As DAO.Database
cnt.Open sConnect
A DAO.Database object does not have an .Open method, which explains "Method or data member not found". Too often error messages can be somewhat vague and just not very helpful. However, in this case, I can't think how the error message could be any more clear.
There is something more which I don't understand. sConnect looks like an ADO connection string. But cnt is a DAO (database) object. You can't mashup the two object models like that in one statement.
You have this just before your active variable declarations:
'Dim cnt As New ADODB.Connection
Then later in your procedure, you have:
'Close the ADO objects
cnt.Close
So perhaps you originally intended cnt to be an ADO.Connection object and didn't adapt the rest of your code after you switched it to a DAO.Database object.
I suggest you revise your code to sort out the DAO vs. ADO confusion, then show us the new code if you have any remaining problems. And please show us only the minimum tested code required to reproduce the problem you're hoping to solve. TIA for your consideration.
这篇关于使用VBA将数据从Excel导出到Access的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
