excel - 试图从多个网页获取数据到excel

Question

我正在尝试从以下网页中提取特定的文本字符串:

http://comptroller.texas.gov/taxinfo/salestax/collections1504.html

1504 代表年年月月，我想减少这个数字直到 0504(2005 年 4 月:http://comptroller.texas.gov/taxinfo/salestax/collections0504.html)。

我想知道如何将其输入 VBA 并让代码为我执行此操作，而不必遍历并复制/粘贴此字符串 120 次。

如果您访问 1504 和 0504 之间的任何链接，我正在寻找的字符串紧跟在第一个“$”之后，一直到 $ 结束(9 个字符)。

先感谢您!

这是我通过一些研究发现的代码:

Sub Macro5()
'
' Macro5 Macro
'

'
Dim Erw, firstRow, lastRow
firstRow = 1
Last Row = Range("B" & Rows.Count).End(xlUp).Row
For Erw = firstRow To lastRow
    Dim newRow
    newRow = firstRow + 4
    Range("B" & newRow).Select
    ActiveCell.FormulaR1C1 = Range("B" & newRow)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;ActiveCell.FormulaR1C1", _
        Destination:=Range("$D$5"))
        .Name = "collections1504_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    nextRow = nextRow + 1
    Next Erw
    Range("D3").Select
    Selection.Copy
    Range("C5").Select
    Range("D3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D5:P143").Select
    Application.CutCopyMode = False
    Selection.QueryTable.Delete
    Selection.ClearContents
End Sub

Answer 1

我不是查询表的粉丝，它们对我来说从来没有那么好用。

以下代码使用实例 InternetExplorer导航到页面并提取字符串。它需要几个额外的引用才能工作，或者需要修改才能使用 CreateObject。

添加引用会将对象添加到 IntelliType，以便更轻松地编辑代码。

您可以在工作表中使用此函数，多次调用可能会使工作表卡住一段时间，但我想 QueryTables 也会发生这种情况。

' This function requires references "Microsoft Internet Controls" and "Microsoft HTML Object Library"
Public Function getTax(ByVal DateCode As String) As String
Dim Browser As InternetExplorer
Dim Document As HTMLDocument
Dim Element As IHTMLElement
Dim Content As String
Dim Response As String
Dim Address As String
Dim Count As Integer: Count = 0

Address = "http://comptroller.texas.gov/taxinfo/salestax/collections" & DateCode & ".html"

Set Browser = New InternetExplorer
Browser.Navigate Address

Do While Browser.Busy And Not Browser.ReadyState = READYSTATE_COMPLETE
    DoEvents
Loop

Set Document = Browser.Document

Do
    Set Element = Document.getElementById("fullPage")

    If Not Element Is Nothing Then
        Exit Do
    Else
        If Count > 5 Then
            Debug.Print "Error: getTax failed to find element."
            Exit Do
        Else
            ' Document might not be ready, give it a second. and try again
            Count = Count + 1
            Application.Wait (Now + #12:00:01 AM#)
        End If
    End If        
Loop

If Element Is Nothing Then
    Response = "[ERROR]"
Else
    Content = Element.innerText
    Response = Mid(Content, InStr(1, Content, "$") + 1, 7)
End If

Set Document = Nothing
Set Element = Nothing
Set Browser = Nothing

getTax = Response

End Function