使用ADODB在Excel工作簿中插入特定表

时间:2018-09-28 23:21:45

标签: excel-vba adodb

我正在尝试使用ADODB在Excel工作表中执行SQL INSERT INTO命令。当使用此代码在工作表中只有一列时,我能够插入工作表:

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

Dim Connection As ADODB.Connection
Set Connection = New ADODB.Connection

Connection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data 
Source=PathToFile.xls;Extended 
Properties=Excel 8.0;"

Connection.Open

Dim SQL As String

SQL = "INSERT INTO [Sheet1$] VALUES('Test')"
Call Connection.Execute(SQL, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)

但是我想在同一工作表中有三个单独的表,并指定要插入其中的表。我怎样才能做到这一点?我尝试创建表,命名它们,并使用此SQL语句指定一个表,但我不断收到错误消息:Microsoft Jet数据库引擎找不到对象“ TestTable1”。确保对象存在,并且正确拼写了它的名称和路径名。

SQL = "INSERT INTO TestTable1(ID) VALUES('test')"

1 个答案:

答案 0 :(得分:0)

您可以执行以下操作:

Sub TestInsert()

    InsertRecords Sheet4.Range("B3").CurrentRegion, _
               "insert into @ values('AAA','BBB','CCC')"

    InsertRecords Sheet4.Range("F3").CurrentRegion, _
               "insert into @ values('ZZZ')"

    InsertRecords Sheet4.Range("H3").CurrentRegion, _
               "insert into @ values('Whirled',99999)"

End Sub



Sub InsertRecords(rng As Range, sSQL As String)

    Const S_TEMP_TABLENAME As String = "SQLtempTable"
    Dim oConn As New ADODB.Connection
    Dim sPath

       'name the selected range
       On Error Resume Next
       ThisWorkbook.Names.Item(S_TEMP_TABLENAME).Delete
       If Err.Number <> 0 Then Err.Clear

       On Error GoTo haveError
       ThisWorkbook.Names.Add Name:=S_TEMP_TABLENAME, RefersToLocal:=rng

       sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name

       oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=" & sPath & _
                  ";Extended Properties=""Excel 8.0;HDR=Yes"""

       oConn.Execute Replace(sSQL, "@", S_TEMP_TABLENAME)

      Exit Sub

haveError:
      MsgBox Err.Description

End Sub

之前:

enter image description here

之后:

enter image description here