在VBA Excel中的SQL查询中使用表名

时间:2017-10-31 07:14:05

标签: vba excel-vba adodb excel

下面是我想通过VBA中的SQL查询操作的excel表。

enter image description here 请找我的VBA代码。

Sub SQL()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT [Sr] FROM [Table1$] WHERE [Sr] >= 3 AND [Sr] <= 8;"

rs.Open strSQL, cn

Sheet5.Range("D1").CopyFromRecordset rs

End Sub

我的上述代码出现以下错误。

enter image description here

请指导我如何在VBA中的SQL查询中操作excel表。

1 个答案:

答案 0 :(得分:2)

使用表别名查询ListObject的范围将起作用。

SQL

  

SELECT [Sr] FROM [Sheet1 $ A1:D15] AS [Table1] WHERE [Sr]&gt; = 3 AND [Sr]&lt; = 8;

代码

Sub SQL()

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset

    strFile = ThisWorkbook.FullName
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
             & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    cn.Open strCon

    strSQL = "SELECT [Sr] FROM " & getListObjectSQLAdress(Sheet1.ListObjects(1)) & " WHERE [Sr] >= 3 AND [Sr] <= 8;"

    rs.Open strSQL, cn

    Sheet5.Range("D1").CopyFromRecordset rs

End Sub

Function getListObjectSQLAdress(tbl As ListObject) As String
    getListObjectSQLAdress = "[" & tbl.Parent.Name & "$" & tbl.Range.Address(False, False) & "] AS [" & tbl.Name & "]"
End Function

从ListObject.Range

构建有效SQL查询表名称的替代方法
Function getListObjectSQLAdress2(tbl As ListObject) As String
    Dim s As String
    s = tbl.Range.Address(False, False, xlA1, xlExternal)
    s = Replace(s, "'[", "`")
    s = Replace(s, "]", "`.[")
    s = Replace(s, "'!", "$")
    getListObjectSQLAdress2 = s & "] AS [" & tbl.Name & "]"
End Function

表名输出

`Untitled (4).xlsx`.[Sheet1$A1:D15] AS [Table1]