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:
Below is the code in full:
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