如何使用VBA改进数据抓取？

Question

我有下面的代码，从内联网获取数据。但它花了更多的时间来获取数据。有人帮我修改代码以提高性能。提前致谢

注意 - 我没有发布URL，因为它是客户网站。对于那个很抱歉。

Sub FetchData() 
Dim IE As Object
Dim Doc As HTMLDocument
Dim myStr As String
On Error Resume Next

  Set IE = CreateObject("InternetExplorer.Application") 'SetBrowser
  IE.Visible = False

IE.navigate "URL" 'Open website
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

Set Doc = IE.Document

Doc.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
Doc.getElementById("txtPassword").Value = InputBox("Please Enter Your                     
Password")
Doc.getElementById("BtnLogin").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

IE.navigate "URL"
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

Dim LastRow As Long

Set wks = ActiveSheet
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowNo = wks.Range("A1:A" & LastRow)
  For rowNo = 2 To LastRow
Doc.getElementById("txtField1").Value =         
ThisWorkbook.Sheets("Sheet1").Range("A" & rowNo).Value
Doc.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click
Do While IE.Busy Or IE.ReadyState <> 4
Application.Wait DateAdd("s", 1, Now)
Loop

strVal1 = Doc.querySelectorAll("span")(33).innerText
ThisWorkbook.Sheets("Sheet1").Range("B" & rowNo).Value = strVal1
strVal2 = Doc.querySelectorAll("span")(35).innerText
ThisWorkbook.Sheets("Sheet1").Range("C" & rowNo).Value = strVal2

Next

End Sub 

Answer 1

不能保证这会运行。注意事项：

1. 使用Worksheets系列
2. 使用Option Explicit - 这意味着您必须始终使用正确的数据类型。目前您有未声明的变量，例如，rowNo用作Long和范围。
3. 去除On Error Resume Next
4. 将所有工作表放入变量中
5. 将值放置到数组和循环数组中以获取id值。环形片很贵
6. 使用早期绑定并向Internet Explorer添加类
7. 假设在登录后存在新的URL并且您需要在每个新的循环值之前导航回到该URL
8. 删除匈牙利表示法
9. Ids是最快的选择器方法，所以没有改进
10. 使用您的css类型选择器，例如.document.querySelectorAll("span")(33)，你可能会寻找是否有一个可以使用的单节点短选择器，而不是使用nodeList

VBA：

Option Explicit  
Public Sub FetchData()
    Dim ie As Object, ie As InternetExplorer
    Dim lastRow As Long, wks As Worksheet, i As Long, ws As Worksheet

    Set ie = New SHDocVw.InternetExplorer        'SetBrowser
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set wks = ActiveSheet                        '<==use explicit sheet name if possible
    lastRow = wks.Cells(wks.rows.Count, "A").End(xlUp).Row
    loopvalues = Application.Transpose(wks.Range("A2:A" & lastRow).Value)

    With ie

        .Visible = False
        .Navigate2 "URL"                         'Open website

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.getElementById("tbxUserID").Value = InputBox("Please Enter Your ID")
        .document.getElementById("txtPassword").Value = InputBox("Please Enter Your Password")
        .document.getElementById("BtnLogin").Click

        While .Busy Or ie.readyState < 4: DoEvents: Wend

        Dim newURL As String, val1 As String, val2 As String
        newURL = .document.URL

        For i = LBound(loopvalues) To UBound(loopvalues)

            .document.getElementById("txtField1").Value = loopvalues(i)
            .document.getElementById("CtrlQuickSearch1_imgBtnSumbit").Click

            While .Busy Or .readyState < 4: DoEvents: Wend

            val1 = .document.querySelectorAll("span")(33).innerText
            ws.Range("B" & i).Value = val1
            val2 = .document.querySelectorAll("span")(35).innerText
            ws.Range("C" & i).Value = val2

            .Navigate2 newURL

            While .Busy Or ie.readyState < 4: DoEvents: Wend
        Next
        .Quit
    End With
End Sub