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

chrissnead

New Member
Joined
Apr 10, 2018
Messages
16
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:

Code:
.all("form:ediKey").innerText = Range("F" & i).Value
Below is the code in full:

Code:
'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
 

Forum statistics

Threads
1,081,860
Messages
5,361,734
Members
400,652
Latest member
cortexnotion

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top