如何使用SQL查询并在VBA中将数据从一个Excel工作表获取到另一个工作表?

时间:2019-03-15 19:46:55

标签: excel vba oledbconnection listobject

我有两本Excel工作簿。一个拥有目标客户列表,另一个具有一张销售数据表。我想使用vba并编写一个sql查询来获取特定客户的销售历史记录,并将该销售历史记录移至“目标客户”工作簿中的新ListObject。最好的方法是什么?

我尝试了OLEDB连接,但似乎无法使其正常工作,我甚至不确定这是否是解决问题的最佳方法。

这是我目前拥有的代码的一个示例。

Public Sub GetSales()

Dim targetList As String

'Get list of target customers
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
counter = Selection.Rows.Count

targetList = "'" & Range("A2").Value & "'"
For x = 2 To counter
    targetList = targetList + ",'" + CStr(Range("A" & CStr(3)).Value) + "'"
Next x


'Query I want to run
'SalesData is the ListObject in the the Sales Data workbook
sqlQuery = "Select * From SalesData WHERE Customer IN " & targetList


    With ActiveWorkbook.Connections("SalesData").OLEDBConnection
        .BackgroundQuery = True
        .CommandText = sqlQuery
        .CommandType = xlCmdSql
        .Connection = Array(something in here??)
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SourceConnectionFile = ""
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
    End With


'Return the queried sales data into a list object _
'on a new sheet in the Target Customers workbook
ActiveWorkbook.Worksheets.Add().Name = "Sales History"
Worksheets("Sales History").Activate

With ActiveSheet.ListObjects.Add '(results of query)
    .DisplayName = "SalesHistory"
End With

End Sub

1 个答案:

答案 0 :(得分:1)

下面是一个简单的连接,可以查询另一个工作簿。

Sub simple_Query()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset

    dbpath = "your path here"
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    strSQL = "SELECT * FROM [Sheet1$] "
    Set vNewWB = Workbooks.Add 'or .CopyFromRecordset rs to open workbook
    connstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbpath & ";Extended Properties=""Excel 12.0; HDR=YES; IMEX=1""; Mode=Read;"
    cn.Open connstr
    Set rs = cn.Execute(CommandText:=strSQL)
    vNewWB.Sheets(1).Range("A2").CopyFromRecordset rs
    For intcolIndex = 0 To rs.Fields.Count - 1
        Range("A1").Offset(O, intcolrndex).Value = rs.Fields(intcolrndex).Name
    Next
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing
End Sub