Question

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

此处的最终目标是从URL中提取数据并将其放入Worksheet(2)。 accountNumber中的值位于URL的末尾，用于从中提取数据。

这是我的第一个VBA脚本，现在就发现了Sub FindData()

错误

我有accountNumbers表。一个帐户的URL是给定的URL，在final =之后带有accountNumber。我试图遍历每个accountNumber的一个网页并从每个网页中提取。

Answer 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。您可以使用工作表限定符，如：表格（“yourname”）。QueryTables等等。你也可以删除点......

Answer 2

查看我的代码，看看这是否有帮助。我添加了很多评论，以帮助您更好地理解整个工作的方式。

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

我希望它有所帮助：）

调试QueryTables.Add脚本

2 个答案: