VBA Internet Controls Macro Running Slow and Stopping at the 242nd Number In List

[chrissnead]

I have written a macro that pulls numbers from a long list and inputs them into a website. After looping through about the 25th number, it seems to start noticeably slowing down more and more. It also seems to crash at 242 numbers and displays 'Run-time Error -2147319783: Automation Error. Old Format or Invalid Type Library.' It stops at the below line:

.all("form:ediKey").innerText = Range("F" & i).Value

Below is the code in full:

'Set these references via Tools -> References in VBA editor:
'Microsoft Internet Controls
'Microsoft HTML Object Library
'Microsoft Shell Controls and Automation


Option Explicit


'https://msdn.microsoft.com/en-us/library/office/gg264421.aspx
'64-Bit Visual Basic for Applications Overview


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    'New VBA version 7 compiler, therefore >= Office 2010
    'PtrSafe means function works in 32-bit and 64-bit Office
    'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    'Old VBA version 6 or earlier compiler, therefore <= Office 2007
    Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
    Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Sub getEDI()


Dim IE As InternetExplorerMedium ' This object (the "medium" variety as opposed to "InternetExplorer") is necessary in our security climate
Dim targetURL As String
Dim HTMLdoc As HTMLDocument
Dim i As Integer
Dim tenderDate As String
Dim tenderYear As String
Dim tenderMonth As String
Dim tenderDay As String
Dim tenderTime As String
Dim element As HTMLGenericElement


Range("F7").Select


i = 7


targetURL = "myURL"
Set IE = New InternetExplorerMedium


LastRow = Range("F" & Rows.Count).End(xlUp).Row


Do Until IsEmpty(Range("F" & i).Value)


    Application.StatusBar = "Progress: " & i - 6 & " of " & LastRow - 6 & ": " & Format((i - 6) / (LastRow - 6), "Percent") & " Complete"


    IE.Visible = False ' Set to true to watch what's happening
    IE.navigate targetURL
    
    While IE.Busy
      DoEvents
    Wend
    
    While IE.Busy  ' The new process may still be busy even after you find it
        DoEvents
    Wend
        
    Set HTMLdoc = IE.document
    
    With HTMLdoc
        ' Go into shipment
        .all("form:ediKey").innerText = Range("F" & i).Value
        Do While IE.readyState <> 4: DoEvents: Loop
        Do
            Set element = HTMLdoc.all("form:searchButton")
            DoEvents
        Loop While element Is Nothing
        element.Click
        While IE.Busy  ' The new process may still be busy even after you find it
            DoEvents
        Wend
        Do While IE.readyState <> 4: DoEvents: Loop
    End With
    
    While IE.Busy
      DoEvents
    Wend
    
    Do While IE.readyState <> 4: DoEvents: Loop
    
    ' Extract results
    Do
        Set element = HTMLdoc.getElementById("form:ediDataTable:0:j_id121")
        DoEvents
    Loop While element Is Nothing
    tenderDate = element.innerText
    tenderYear = Left(tenderDate, 4)
    tenderMonth = Mid(tenderDate, 6, 2)
    If Left(tenderMonth, 1) = "0" Then
        tenderMonth = Right(tenderMonth, 1)
    End If
    tenderDay = Mid(tenderDate, 9, 2)
    If Left(tenderDay, 1) = "0" Then
        tenderDay = Right(tenderDay, 1)
    End If
    tenderTime = Mid(tenderDate, 12, 5)
    tenderTime = Format(tenderTime, "hh:mm")
    tenderDate = tenderMonth & "/" & tenderDay & "/" & tenderYear
    
    Range("B" & i).Value = tenderDate
    Range("C" & i).Value = tenderTime
    
    i = i + 1
Loop


IE.Quit
Set IE = Nothing


Application.StatusBar = False


End Sub