Debugging a QueryTables.Add script

问题

Sub FindData()

Dim accountNumber As Range
Set accountNumber = Range(Range("A2"), Range("A2").End(xlDown))
Dim dataSet As QueryTable

For Each Value In accountNumber
    Set dataSet = .QueryTables.Add( _
            Connection:="URL;http://www.prad.org/CamaDisplay.aspx?OutputMode=Display&SearchType=RealEstate&ParcelID=" & Value, _
            Destination:=ThisWorkbook.Worksheets(2).Range("A1"))
    Next Value

With dataSet
    .RefreshOnFileOpen = False
    .WebFormatting = xlWebFormattingNone
    .BackgroundQuery = True
    .WebSelectionType = xlSpecifiedTables
    .WebTables = "3"
End With

With Application
    dataSet.Refresh BackgroundQuery:=False
End With

End Sub

The ultimate goal here is to pull data from the URL and drop it into Worksheet(2). The values in accountNumber go at the end of the URL for each page to draw data from.

This is my first VBA script, and right off the bat, it's giving me an error on Sub FindData()

I have the table of accountNumbers. The URL for one account is the given URL with an accountNumber after the final =. I am trying to iterate through one webpage per accountNumber and extract from each.

回答1:

Set dataSet = ActiveSheet.QueryTables.Add( _
        Connection:="URL;http://www.prad.org/CamaDisplay.aspx?OutputMode=Display&SearchType=RealEstate&ParcelID=" & Value, _
        Destination:=ThisWorkbook.Worksheets(2).Range("A1"))

QueryTables needs to be properly referenced. You can use a sheet qualifier like : Sheets("yourname").QueryTables or something. You can remove the dot too...

回答2:

Look into my code and see if this helps. I added a lot of comments to help you understand better the way the whole thing works.

Option Explicit

Sub FindData()

    Const strURL As String = "URL;http://www.prad.org/CamaDisplay.aspx?OutputMode=Display&SearchType=RealEstate&ParcelID="

    Dim shActive As Worksheet
    Dim shDestination As Worksheet
    Dim oQuery As QueryTable
    Dim rAccounts As Range
    Dim rAccount As Range


    'Initialize the variables
    Set shActive = ActiveSheet

    ' Note the "." in front of the ranges. That's how you use "With"
    With shActive
        Set rAccounts = .Range(.Range("A2"), .Range("A2").End(xlDown))
    End With

    ' Remove any old query otherwise they will pile up and slow down
    ' your workbook
    Call RemoveSheetQueries(shActive)


    ' Loop through the accounts and add the queries
    For Each rAccount In rAccounts
        Set oQuery = Nothing
        Set oQuery = shActive.QueryTables.Add(Connection:=strURL & rAccount.Value, _
                                              Destination:=shActive.Range("A1"))

        ' Set the properties of the new query and eventually run it.
        With oQuery
            .RefreshOnFileOpen = False
            .WebFormatting = xlWebFormattingNone
            .BackgroundQuery = True
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "3"

            ' This last line will actually get the data
            .Refresh BackgroundQuery:=False
        End With
    Next rAccount

End Sub



' Procedure to remove all old Queries
Sub RemoveSheetQueries(ByRef shToProcess As Worksheet)

    Dim lTotal As Long
    Dim i As Long

    lTotal = shToProcess.QueryTables.Count

    For i = lTotal To 1 Step -1
        shToProcess.QueryTables(i).Delete
    Next i

End Sub

I hope it helps :)

来源：https://stackoverflow.com/questions/33814016/debugging-a-querytables-add-script

标签

excel

vba

excel-vba

debugging