excel VBA效率XMLHTTP60

如何解决excel VBA效率XMLHTTP60

我已经在这个网站上停留了很长时间，并且我很高兴从您看到的每个回复中学到的一切。现在，我希望有效地运行在您的帮助下编写的代码。

问题1-运行代码时页面显示为“无响应”。每次运行大约发生4次。另外，我将在大约1分钟40秒内获得数据。我的公司没有最好的互联网，所以这可能就是为什么要花这么长时间的原因。

问题2-是否有更好的方法遍历循环，使代码位于单个宏而不是10个单独的宏中。我的网站仅更改了URL中的四个字母部分（在下面的第二个代码中显示为DYNAMICPORTION。我试图用指向范围的URL进行循环，但无法弄清楚如何将此信息放置在新的循环中的工作表。

任何帮助将不胜感激！再次感谢！

主宏

Sub GetAllData()

Dim t As Date
t = Now()

Application.Calculation = xlManual

    Application.StatusBar = "Gathering Data 10%"
GetSiteData
    Application.StatusBar = "Gathering Data 20%"
GetSite2Data
    Application.StatusBar = "Gathering Data 30%"
GetSite3Data
    Application.StatusBar = "Gathering Data 40%"
GetSite4Data
    Application.StatusBar = "Gathering Data 50%"
GetSite5Data
    Application.StatusBar = "Gathering Data 60%"
GetSite6Data
    Application.StatusBar = "Gathering Data 70%"
GetSite7Data
    Application.StatusBar = "Gathering Data 80%"
GetSite8Data
    Application.StatusBar = "Gathering Data 90%"
GetSite9Data
    Application.StatusBar = "Gathering Data 100%"
GetSite10Data

    Application.Calculation = xlAutomatic
    Application.StatusBar = Ready
    
MsgBox "It took " & Format(Now() - t,"hh:mm:ss") & " to gather the site's data!" & vbNewLine & "Please allow a minute to calculate!"

End Sub

主要下的宏

Sub GetSiteData()
Dim XMLRequest As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLTable As MSHTML.IHTMLElement
Dim HTMLTable2 As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim RowNum As Long,ColNum As Long
Dim url As String: url = "https://thewebsite/theproduct/isextracted/index.cfm?site=DYNAMICPORTION&type=data"
Dim OutputSheet As Worksheet

Set OutputSheet = ThisWorkbook.Worksheets("Site")
OutputSheet.Cells.ClearContents

XMLRequest.Open "GET",url,False
XMLRequest.send
Do While XMLRequest.readyState <> 4
    DoEvents
Loop
HTMLDoc.body.innerHTML = XMLRequest.responseText

Set HTMLTable = HTMLDoc.getElementById("TAB7")
Set HTMLTable2 = HTMLDoc.getElementById("TAB5")

RowNum = 0
ColNum = 0

    For Each TableRow In HTMLTable.getElementsByTagName("tr")
        RowNum = RowNum + 1
        For Each TableCell In TableRow.Children
            ColNum = ColNum + 1
            OutputSheet.Cells(RowNum,ColNum).Value = TableCell.innerText
        Next TableCell
        ColNum = 0
    Next TableRow

    For Each TableRow In HTMLTable2.getElementsByTagName("tr")
        RowNum = RowNum + 1
        For Each TableCell In TableRow.Children
            ColNum = ColNum + 1
            OutputSheet.Cells(RowNum,ColNum).Value = TableCell.innerText
        Next TableCell
        ColNum = 0
    Next TableRow

End Sub