Question

我有一个VBA脚本，它从网站获取HTML数据并将其放入excel中。它导航到大约有100个网页，有时会卡住，或者最终使用了大量的内存，我需要关闭IE并重新开始。互联网资源管理器的更新是在另一个子程序中进行的。我想要回答的问题是如何检查脚本是否丢失了ie对象。我不能使用If Not (ie Is Nothing) Then，因为即存在，但没有变量。如果我尝试ie.Count我只是收到错误。这是完整的代码（ie对象在主代码中声明）：

Sub refresh_Page(ie, ByVal websiteName As String, numTries)

numTries = numTries + 1
If Not (ie Is Nothing) Then
    If Not (ie.Count = 0) Then
    ie.Quit
    Set ie = Nothing
    End If
End If

Application.Wait (Now + TimeValue("00:00:20"))
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate websiteName
iSecondCounter = 0
'Wait until the website has loaded
Do While ie.Busy And iSecondCounter < 30
Application.Wait DateAdd("s", 1, Now)
iSecondCounter = iSecondCounter + 1
Loop

If iSecondCounter = 30 And numTries <= 3 Then
    Call refresh_Page(ie, websiteName, numTries)
    ElseIf numTries = 3 Then
    MsgBox "Error with " & websiteName & " exiting code"
    Exit Sub
    End If
End Sub

主要代码：

Sub Refresh_data()

Dim ie, dataListCum As Object
Dim websiteName As String
Dim startTimem, SecondsElapsed As Double
Dim numRows, numCols As Long
Dim cumulativeItem() As String
Dim lenArray, numTries As Integer
Dim underlying() As Variant
Dim FI, UM As Worksheet

'Start timer
startTime = Timer

'Open internet explorer
Set ie = CreateObject("InternetExplorer.Application")
'ie.Visible = True

'Stop excel automatically calculating and updating the sheet each loop
Application.Calculation = xlCalculationManual

'Set up the underlying markets data to be written into excel later
Set FI = ThisWorkbook.Sheets("fund_info")
Set UM = ThisWorkbook.Sheets("underlying_markets")

numRows = UM.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
numCols = UM.Range("A1:AA1").Cells.SpecialCells(xlCellTypeConstants).Count + 1

ReDim underlying(numRows, numCols)

For i = 1 To numRows
underlying(i, 1) = UM.Range("A" & (i + 1)).Value
Next i

For rowNum = 2 To 124
'Refresh Internet explorer every 10 goes
numTries = 0
If rowNum Mod 10 = 0 Then
    ie.Quit
    Set ie = Nothing
    Application.Wait (Now + TimeValue("00:00:15"))
    Set ie = CreateObject("InternetExplorer.Application")
    End If

websiteName = FI.Range("G" & rowNum).Value

'In a few instances I couldn't get trustnet data - I'll work on those later
If Mid(websiteName, 13, 8) = "trustnet" Then
    ie.navigate websiteName

On Error Resume Next

    iSecondCounter = 0
    'Wait until the website has loaded
    Do While ie.Busy
    Application.Wait DateAdd("s", 1, Now)
    iSecondCounter = iSecondCounter + 1
     'If the page is taking too long to load then refresh the page
        If iSecondCounter > 30 Then Call refresh_Page(ie, websiteName, numTries)
    Loop

    'Give it a few seconds to fully load - this website is problematic
    Application.Wait (Now + TimeValue("00:00:13"))

    'Scrape the data using HTML search
    Set dataListCum = ie.Document.querySelectorAll("performance-table table td")

    'Sometimes the data doesn't come in, so refresh the page and try again
    While dataListCum.Length = 0 Or IsNull(dataListCum.Item(1))
        Call refresh_Page(ie, websiteName, numTries)
        Application.Wait (Now + TimeValue("00:00:13"))
        Set dataListCum = ie.Document.querySelectorAll("performance-table table td")
        Wend


    'Collect the data
    lenArray = dataListCum.Length
    ReDim cumulativeItem(lenArray)
    'Write the data into excel
    For i = 1 To lenArray - 1
        cumulativeItem(i) = dataListCum.Item(i).innerText
        Next i

    'Need to check if underlying market data has already been created
    Dim Market As String

    Market = FI.Range("M" & rowNum).Value

    For i = 1 To numCols
        If underlying(i, 1) = Market Then
            If IsEmpty(underlying(i, 2)) Then
            updateMarket = 1
            Exit For
            Else
            updateMarket = 0
            Exit For
            End If
        End If
        Next i



    Debug.Print rowNum

    'Write the data into excel
    For i = 1 To 5
        Select Case lenArray 'Sometimes there is no underlying market to compare against

        Case 36
        Debug.Print cumulativeItem(i); " / "; cumulativeItem(i + 24)
        FI.Range("N" & rowNum).Offset(0, i - 1).Value = cumulativeItem(i)
        FI.Range("S" & rowNum).Offset(0, i - 1).Value = cumulativeItem(i + 24)
        'If we need to update the underlying market data
        If updateMarket = 1 Then
            For j = 1 To numCols
                If underlying(j, 1) = Market Then
                    For k = 1 To 5
                        underlying(j, k + 1) = cumulativeItem(i + 6)
                        underlying(j, k + 6) = cumulativeItem(i + 30)
                        Next k
                    End If
                Next j
            End If

        Case 12
        Debug.Print cumulativeItem(i); " / "; cumulativeItem(i + 6)
        FI.Range("N" & rowNum).Offset(0, i - 1).Value = cumulativeItem(i)
        FI.Range("S" & rowNum).Offset(0, i - 1).Value = cumulativeItem(i + 6)
        End Select
        Next i

End If
Next rowNum

'Close internet explorer
ie.Quit
Set ie = Nothing

'Write the underlying market data to excel
UM.Range("A2:K20").Value = underlying()

'Turn on automatic calculation
Application.Calculation = xlCalculationAutomatic

'Stop timer
SecondsElapsed = Round(Timer - startTime, 2)
MsgBox "This code took " & SecondsElapsed & " seconds"

End Sub

Excel VBA刷新Internet Explorer页面

0 个答案: