My goal is to open a site, input into the forms, save a report through a button, and then loop around and continue for the next entry. I am using the Microsoft WinHTTP, HTML object library, and Internet Controls.
This works so long as I have no "Open/Save As" prompt in Internet Explorer. It successfully loops through the results and clicks the report button, then restarts. However, once the prompt appears, it causes a break in line " svalue1.Value = ws.Cells(Lastrow, 1).Value " reporting Error 91, object not found, that I can't for the life of me understand. Why would the save prompt break a VBA script?
Commented out is some of the fixes I've tried, but nothing seems to resolve this issue. Am I missing something obvious?
Thank you for taking the time to help a newbie out with this! :)
Enum READYSTATE
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4
End Enum
Sub Test()
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'set the Sheet you are using here
Dim ie As New InternetExplorerMedium
'Set ie = New InternetExplorerMedium
Dim HTML As HTMLDocument
Dim i As Long
Lastrow = ws.Range("A1").End(xlDown).Row
'get the last row with a value in column A
strURL = "www.coollinkExample.com" 'set your initial URL here
ie.Visible = True
ie.navigate strURL
Do While (ie.Busy Or ie.READYSTATE <> READYSTATE.READYSTATE_COMPLETE)
DoEvents
Loop
Set HTML = ie.document
'-----------------INIT-----------------
'For i = 1 To Lastrow Step 1 'loop from row 1 to Last
Do While i < Lastrow 'loop from row 1 to Last
'Do While (ie.Busy Or ie.READYSTATE <> READYSTATE.READYSTATE_COMPLETE)
'DoEvents
'Loop BUGS WHEN SAVE PROMPT IS UP?
'-----------------BODY-----------------
'Do your data scraping here, then below go back to your initial URL to repeat the process
delay 5
Set svalue1 = HTML.getElementById("userNameText")
ie.document.getElementById("userNameText").Focus
svalue1.Value = ws.Cells(Lastrow, 1).Value 'enter the value from current cell
delay 2
ie.document.getElementById("btnSearchUser").Focus
HTML.getElementsByName("btnSearchUser").Item.Click
delay 3
ie.document.getElementById("rptUsers_ctl00_ddlUserOptions").Focus
HTML.getElementsByName("rptUsers_ctl00_ddlUserOptions").Item.Click
delay 3
ie.document.getElementById("rptUsers_ctl00_ddlUserOptions_lnkTranscript").Focus
HTML.getElementsByName("rptUsers_ctl00_ddlUserOptions_lnkTranscript").Item.Click
delay 3
ie.document.getElementById("__ta").Focus
HTML.getElementsByName("__ta").Item.Click
delay 2
ie.document.getElementById("__tj").Focus
HTML.getElementsByName("__tj").Item.Click
delay 4
With ie.document.getElementById("ctl00_ContentPlaceHolder1_btnExport")
.Focus
.Click
End With
delay 5
Application.SendKeys "%{S}"
delay 3
'-----------------END-----------------
ie.navigate strURL
delay 5
'Exit For
'Next i
i = i 1
Loop
End Sub
'// This function below works fine.
Private Sub delay(seconds As Long)
Dim endTime As Date
endTime = DateAdd("s", seconds, Now())
Do While Now() < endTime
DoEvents
Loop
End Sub
CodePudding user response:
You have ie.navigate strURL
at the end of the loop but are not waiting for the page to load fully.
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim ie As InternetExplorerMedium
Dim doc As HTMLDocument, strURL As String
Dim i As Long, lastrow As Long
strURL = "www.coollinkExample.com" 'set your initial URL here
Set ie = New InternetExplorerMedium
ie.Visible = True
Set ws = Sheets("Sheet1")
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
' navigate to site
ie.navigate strURL
Do While ie.Busy Or ie.READYSTATE <> 4 'READYSTATE.READYSTATE_COMPLETE)
DoEvents
Loop
Set doc = ie.document
delay 5
doc.getElementById("userNameText").innerText = Trim(.Cells(i, "A"))
delay 3
doc.getElementById("btnSearchUser").Click
delay 3
doc.getElementById("rptUsers_ctl00_ddlUserOptions").Click
delay 3
doc.getElementById("rptUsers_ctl00_ddlUserOptions_lnkTranscript").Click
delay 3
doc.getElementById("__ta").Click
delay 3
doc.getElementById("__tj").Click
delay 3
doc.getElementById("ctl00_ContentPlaceHolder1_btnExport").Click
delay 5
Application.SendKeys "%(S)"
delay 3
Next i
End With
ie.Quit
MsgBox "Done", vbInformation
End Sub