使用VBA将数据从Excel导出到Access

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.

我在一个包含一些数据的Excel文件中有一个表，我想将这些数据导出到Access上的数据库（在我的数据库的一个名为Water Quality的具体表中），并带有VBA代码，以避免每次我打开我的数据库想要介绍更多的数据。

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

目前，问题是当我调试代码时，出现编译错误：“cnt.Open sConnect”函数中的“找不到方法或数据成员”。

If this is possible, any help would be greatly appreciated.

如果可以，任何帮助将不胜感激。

Note: I'm using Office 2010.

注意：我正在使用Office 2010。

2 个解决方案

#1

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.

DAO.Database对象没有.Open方法，该方法解释“未找到方法或数据成员”。很多时候，错误消息可能有些模糊，而且不是很有帮助。但是，在这种情况下，我无法想象错误消息如何更清楚。

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.

还有一些我不理解的东西。 sConnect看起来像一个ADO连接字符串。但是cnt是一个DAO（数据库）对象。您不能在一个语句中混搭这两个对象模型。

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.

因此，您最初可能希望cnt成为ADO.Connection对象，并且在将其切换为DAO.Database对象后，不会调整其余代码。

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.

我建议你修改你的代码来理清DAO与ADO的混淆，如果你有任何遗留的问题，请告诉我们新的代码。请向我们展示重现您希望解决的问题所需的最低测试代码。 TIA供您考虑。

#2

I only have Access databases that open the excel file (instead of the other way around) but from looking through my code I think you should go straight to this:

我只有Access数据库打开excel文件（而不是相反），但通过查看我的代码，我认为你应该直接这样做：

`Set cnt = OpenDatabase_
       (dbPath, False, True, "Access 8.0;")

Found this on http://support.microsoft.com/kb/190195 too.

在http://support.microsoft.com/kb/190195上也找到了这个。

Does this help?

这有帮助吗？

#1