VBA IE automation - controlling child/new window - vba

I'm hoping someone can help me out. I have a company website I am trying to navigate through so when I finally manage to get to the place I need to be I can automate some form completion.
I am to a place in the code where a link is "clicked" via the code, and a new window opens up. I need to be able to click a link on the new window, and then switch control back to the parent window.
I've seen a few methods of doing this, but they are not working for me, or more likely I am not inserting them into my code correctly.
I have the shell method placed into my code, and there are no errors thrown when this is run, but it isn't doing anything, and I am not sure if the control is even being moved to the child window.
Can anyone assist?
Sub Fill_FormLog()
Dim ie As InternetExplorer
Dim URL As String
Dim objElement As Object
Dim objButton As Object
Dim objLink As Object
Dim objLink2 As Object
Dim objShell As Object
'Logs into website
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate URL:="***parentwindowURL***"
Do Until .ReadyState = 4
DoEvents
Loop
Set mytextfield1 = .Document.all.Item("txtUserName")
mytextfield1.Value = "***username***"
Set mytextfield2 = .Document.all.Item("txtPassword")
mytextfield2.Value = "***password***"
ie.Document.getElementById("Submit").Click
While .Busy Or .ReadyState <> 4: DoEvents: Wend
End With
'Opens the a link
With ie
While .Busy Or .ReadyState <> 4: DoEvents: Wend
ie.Navigate "***URLstillinparent***", , self
End With
'Opens the Profile menu
With ie
While .Busy Or .ReadyState <> 4: DoEvents: Wend
ie.Navigate "***anotherURLinparent***", , ["left"]
End With
'Opens the Profile search menu
With ie
While .Busy Or .ReadyState <> 4: DoEvents: Wend
ie.Navigate "***anotherURLinparent***", , ["mainParent"]
End With
'Copies the ID# from the Excel worksheet and pastes it to search in site
With ie
While .Busy Or .ReadyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))
Set objElement = .Document.frames("mainParent").Document.frames("main1").Document.forms("AgentIdentificationNumberSearch").Document.getElementById("IDN")
objElement.Value = Sheets("Appointments").Range("a2").Value
Set objButton = .Document.frames("mainParent").Document.frames("main1").Document.forms("AgentIdentificationNumberSearch").Document.getElementById("Search")
objButton.Click
End With
'Opens view profile summary via child window
With ie
While .Busy Or .ReadyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))
Set objLink = .Document.frames("mainParent").Document.forms("AgentProfileList").Document.getElementById("grdProfile_r_0").Document.getElementsByTagName("a")(1)
objLink.Click
End With
'Should move control to child window
Application.Wait (Now + TimeValue("0:00:05"))
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).LocationURL
my_title = objShell.Windows(x).Document.Title
If my_url Like "***URLofChild/NewWindow***" Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next
'Should click a link on the child window
With ie
While .Busy Or .ReadyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))
Set objLink2 = .Document.forms("form1").Document.getElementsByClassName("topHead").Document.getElementById("topLinks").Document.getElementsByTagName("a")(1)
objLink2.Click
End With
'if I can get the section above to work, I need to return control to the parent window at this point
End Sub

I found some code on another site that worked to control the child window, and was able to proceed, but I had another issue do deal with which made this unnecessary. At least I know how to do it now. The code that worked for me is below.
The code must be in an object instead of a module to work.
Option Explicit
Public WithEvents IE1 As InternetExplorer
Public IE2 As InternetExplorer
Private Sub Automation()
Dim objElement As Object
Dim objButton As Object
Dim objLink As Object
Dim objLink2 As Object
Dim mytextfield1 As Object
Dim mytextfield2 As Object
Set IE1 = CreateObject("internetexplorer.application")
Set IE2 = Nothing
With IE1
.navigate "***website url***"
.Visible = True 'allows for viewing the web page
While .Busy Or .readyState <> 4: DoEvents: Wend
Set mytextfield1 = .document.all.Item("txtUserName")
mytextfield1.Value = "***username***"
Set mytextfield2 = .document.all.Item("txtPassword")
mytextfield2.Value = "***password***"
While .Busy Or .readyState <> 4: DoEvents: Wend
IE1.document.getElementById("Submit").Click
End With
' loop until the page finishes loading
Do While IE1.Busy: Loop
'Opens another link
With IE1
While .Busy Or .readyState <> 4: DoEvents: Wend
IE1.navigate "***url***"
End With
'Opens the menu
With IE1
While .Busy Or .readyState <> 4: DoEvents: Wend
IE1.navigate "***URL in frame***", ["left"]
End With
'Opens the Profile search menu
With IE1
While .Busy Or .readyState <> 4: DoEvents: Wend
IE1.navigate "***url in another frame***", , ["mainParent"]
End With
'Copies the ID# from the Excel worksheet and pastes it to search in site to search
With IE1
While .Busy Or .readyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:03"))
Set objElement = .document.frames("mainParent").document.frames("main1").document.forms("AgentIdentificationNumberSearch").document.getElementById("IDN")
objElement.Value = Sheets("Appointments").Range("a2").Value
Set objButton = .document.frames("mainParent").document.frames("main1").document.forms("AgentIdentificationNumberSearch").document.getElementById("Search")
objButton.Click
End With
'Clicks "View Profile Summary" and opens new window
With IE1
While .Busy Or .readyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:03"))
Set objLink = IE1.document.frames("mainParent").document.forms("AgentProfileList").document.getElementById("grdProfile_r_0").document.getElementsByTagName("a")(1)
objLink.Click
End With
'Ensure new window has been created (if the window does not generate, this will go on forever)
Do While IE2 Is Nothing: Loop
Do While IE2.Busy: Loop
'Click first link in the new window
With IE2
While .Busy Or .readyState <> 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:03"))
Set objLink2 = IE2.document.forms("form1").document.getElementsByTagName("a")(2)
objLink2.Click
End With
Set IE2 = Nothing
End Sub
________________________
Private Sub IE1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Set IE2 = New InternetExplorer
Set ppDisp = IE2.Application
Debug.Print "NewWindow2"
End Sub

Related

IE VBA How to click on a SVG element

My goal is to automate the process that requires going into a certain website, enter a BOL number and then click on search button in order to consult a document.
I haven't been able to click on the search button.
Dim oBrowser As Object
Dim HTMLdoc As MSHTML.HTMLDocument
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlColl As MSHTML.IHTMLElementCollection
Set oBrowser = CreateObject("InternetExplorer.Application")
With oBrowser
'Open Browser
.navigate "https://www.paquetexpress.com.mx/rastreo-de-envios"
.Visible = 1
Do While .readyState <> 4:
DoEvents:
Loop
Application.Wait (Now + TimeValue("0:00:02"))
'Enter BOL Number
Set HTMLdoc = .document
Set htmlColl = HTMLdoc.getElementsByTagName("INPUT")
Do While HTMLdoc.readyState <> "complete": DoEvents: Loop
For Each htmlInput In htmlColl
If htmlInput.Name = "trackingguides" Then
htmlInput.Value = "10101010101"
Exit For
End If
Next htmlInput
'************* I'm having issues with this section **************
'Click Search
Set HTMLdoc = .document
Set htmlColl = HTMLdoc.getElementsByTagName("svg")
x = 1
Do While HTMLdoc.readyState <> "complete": DoEvents: Loop
For Each htmlInput In htmlColl
If InStr(1, htmlInput.outerHTML, "0 0 16 16") > 0 Then
If htmlInput.offsetTop > 5 Then
htmlInput.Click
Exit For
End If
End If
Next htmlInput
'**************************************************************
End With
Based on the site and what you are trying to do, this should work:
HTMLdoc.getElementsByClassName("svg-icon svg-fill")(1).Click
This would be an optimized method but page seems to hang for me
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub EnterInfo()
Dim ie As New InternetExplorer, event_onClick As Object
With ie
.Visible = True
.Navigate2 "https://www.paquetexpress.com.mx/rastreo-de-envios"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
Set event_onClick = .createEvent("HTMLEvents")
event_onClick.initEvent "click", True, False
.querySelector("#tracking__input__container input").Value = "10101010101"
With .querySelector(".searchicon")
.FireEvent "onclick"
.dispatchEvent event_onClick
End With
End With
Stop
.Quit
End With
End Sub

Referring to html element

Could you tell me what's wrong with this code:
Public Sub GetInfo()
Dim IE As Object, html As Object
With CreateObject("InternetExplorer.Application")
.Visible = True
.navigate "https://pl.pons.com/tłumaczenie"
While .Busy Or .readyState < 4: DoEvents: Wend
Set html = CreateObject("htmlfile")
Set html = .document
With html
.getElementsByTagName("span")(22).Click
.getElementsByTagName("span")(109).Click
.getElementByID("q").Value = "rower"
.querySelector("button.btn.btn-primary.submit").Click
Application.Wait Now + TimeSerial(0, 0, 3)
translation = .getElementsByTagName("dd")(0).innerText
Stop
End With
.Quit
End With
End Sub
It works but translation returns nothing. I use late binding and I can't change it.

Get Excel to wait for IE to load - Intermittent 424 Object Required Error

My code scrapes an internal site to our company for data tables. It will hit the website many times depending on how many accounts the user needs to return. We intermittently get an
424 Object Required
in the function that gets the data from the website. I think when the load on our intranet is higher, it slows the system which may lead to this error.
I want to ensure the webpage loads before trying to obtain info from the data table. This is where my code is today:
' IE Version 8+
Set objIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
DoEvents
With objIE
.Visible = False
.Navigate "internalsite.aspx"
While .Busy = True Or .Readystate <> 4: DoEvents: Wend
While .Document.Readystate <> "complete": DoEvents: Wend
.Document.getElementById("Region_txtAccount").Value = sAccountNum
While .Busy = True Or .Readystate <> 4: DoEvents: Wend
While .Document.Readystate <> "complete": DoEvents: Wend
.Document.getElementById("Region_bRunInfo").Click
While .Busy = True Or .Readystate <> 4: DoEvents: Wend
While .Document.Readystate <> "complete": DoEvents: Wend
End With
thisCol = 53
thisColCustInfo = 53
GetOneTable objIE.Document, 9, thisCol
'Cleanup:
objIE.Quit
Set objIE = Nothing
GetWebTable_Error:
Select Case Err.Number
Case 0
Case Else
Debug.Print Err.Number, Err.Description
Stop
End Select
I believe this thread holds the solution. I just need a little insight in applying it to my code.
The unfortunate issue with Internet Explorer's .Busy and .readyState is that it is not 100% reliable with some web pages.
So a hack you can use to fix your issue is to simply wait for your object to become available. Your object would be the one that is raising the error.
Sub ieBusy(ie As Object)
Do While ie.busy Or ie.readystate < 4
DoEvents
Loop
End Sub
Sub Test()
Dim objIE As Object
Set objIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") ' IE Version 8+
DoEvents
With objIE
.Visible = False
.Navigate "internalsite.aspx"
ieBusy objIE
' this is your hack:
On Error Resume Next
Do While .Document.getElementById("Region_txtAccount") Is Nothing
DoEvents
Loop
On Error GoTo 0
.Document.getElementById("Region_txtAccount").Value = sAccountNum
ieBusy objIE
' this is your hack:
On Error Resume Next
Do While .Document.getElementById("Region_bRunInfo") Is Nothing
DoEvents
Loop
On Error GoTo 0
.Document.getElementById("Region_bRunInfo").Click
ieBusy objIE
End With
thisCol = 53
thisColCustInfo = 53
GetOneTable objIE.Document, 9, thisCol
'Cleanup:
objIE.Quit
Set objIE = Nothing
GetWebTable_Error:
Select Case Err.Number
Case 0
Case Else
Debug.Print Err.Number, Err.Description
Stop
End Select
End Sub

How to select values from Dropdown menu on a webpage:VBA

My code :
Sub login()
Dim IE As Object
Dim HTMLDoc As Object, HTMLDoc2 As Object
Dim objCollection As Object
Const navOpenInNewTab = &H800
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https:/com/1/19/login.esp"
Do While IE.Busy Or IE.ReadyState <> 4: Loop
Set HTMLDoc = IE.Document
With HTMLDoc
HTMLDoc.getElementById("USERNAME").Value = "xxxx" 'Entering credential
HTMLDoc.getElementById("PASSWORD").Value = "yyyyy"
End With
Set objCollection = IE.Document.getElementById("loginbutton")
objCollection.Click
'Second webpage
Do While IE.Busy Or IE.ReadyState <> 4: Loop ' opening the second webpage
Set HTMLDoc2 = IE.Document
With HTMLDoc2
**HTMLDoc2.getElementById("DEPARTMENTID").selectedindex = 1 'Drop down menu
HTMLDoc2.getElementById("DEPARTMENTID").FireEvent ("onchange")**
End With
Set objCollection = IE.Document.getElementById("loginbutton")
objCollection.Click
End Sub
Q)What code changes do I do to select Dwell_DF option Value 1567?
The above code gives run time error '424' : Object required.
HTMLDoc2.getElementById("DEPARTMENTID").selectedindex = 1 'Drop down menu
HTMLDoc2.getElementById("DEPARTMENTID").FireEvent ("onchange")
The above line give the error.
In the first webpage I fill the login credentials then in the next page is that of the image pasted with this post. Here I want to change the value in the drop down menu.
Give this a try. The value "1567" corresponds with the InnerText "Dwell_DF".
With HTMLDoc2
.getElementById("DEPARTMENTID").Focus
.getElementById("DEPARTMENTID").Value = "1567" 'You can also loop to find the text of the Option
.getElementById("DEPARTMENTID").FireEvent ("onchange")
End With
It should be something like this.
Sub passValueToComboBox1()
Dim ie As Object
Dim oHTML_Element As IHTMLElement
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://your_URL_here.php"
While ie.Busy Or ie.readyState <> 4: DoEvents: Wend
Set oHTML_Element = ie.document.getElementsByName("selectedReportClass")(0)
If Not oHTML_Element Is Nothing Then oHTML_Element.Value = "FUBU7"
For Each oHTML_Element In ie.document.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
End Sub
Check out the link below for some other ideas of how to programatically interact with a web site.
http://vbadud.blogspot.com/2009/08/how-to-login-to-website-using-vba.html

IE innerHTML after clicking on link

I'm using Excel-vba, and trying to get the innerHTML of an InternetExplorer Object, my problem is that after clicking on a link, the innerHTML doesn't change and stays as the first navigation.
is there a way to get the innerHTML of the next page after clicking the link?
Here is the code:
Dim ie As InternetExplorer
Dim hd As HTMLDocument
Set ie = New InternetExplorer
ie.navigate "http://www.stormchaser.niu.edu/machine/textfcstsound.html"
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set hd = ie.document
hd.all.Item("mo")(4).Checked = True
hd.all.Item("ft")(11).Checked = True
Set objInputs = ie.document.getElementsByTagName("input")
For Each ele In objInputs
If ele.Type = "submit" Then
ele.Click
End If
Next
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
hd.Links(0).Click
Range("K4") = ie.document.body.innerHTML
I'd really thank for any help.
Jon
It looks likes a timing issue which I find is a very common problem in automating IE. The code is not waiting for the following page to load before executing hd.Links(0).Click so it is actually clicking a link on the old page. I tested the following code and it seems to run fine. It is using the page title as a check if it is loaded instead of ie.ReadyState which doesn't seem to be working.
Sub test()
Dim ie As InternetExplorer
Dim hd As HTMLDocument
Set ie = New InternetExplorer
ie.Navigate "http://www.stormchaser.niu.edu/machine/textfcstsound.html"
ie.Visible = True
Do While ie.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set hd = ie.Document
hd.all.Item("mo")(4).Checked = True
hd.all.Item("ft")(11).Checked = True
Set objInputs = ie.Document.getElementsByTagName("input")
For Each ele In objInputs
If ele.Type = "submit" Then
ele.Click
'Debug.Print ele.outerHTML
End If
Next
Do While hd.Title <> "Forecast Sounding Text Output for KOKC" ' ie.ReadyState <> READYSTATE_COMPLETE
'Debug.Print hd.Title, hd.Links(0)
'DoEvents
Loop
'While ie.ReadyState <> READYSTATE_COMPLETE: Wend
Set hd = ie.Document
Debug.Print hd.Title, hd.Links(0)
hd.Links(0).Click
'Do While ie.ReadyState <> READYSTATE_COMPLETE
' DoEvents
'Loop
While ie.ReadyState <> READYSTATE_COMPLETE: Wend
Do While hd.Title <> "" ' ie.ReadyState <> READYSTATE_COMPLETE
Loop
Debug.Print hd.Title, hd.body.innerHTML
Range("K4") = hd.body.innerHTML
End Sub
I would also suggest ie.Visible for debugging. Hope that helps.
I got it, you're right that it's a timing issue, I found out how to catch the right second for calling the innerHTML method without freezing Excel, it gives Excel a timeout of 20 seconds waiting for the new window, otherwise it returns "failed".
here is the full code:
Set ie = New InternetExplorer
ie.navigate "http://www.stormchaser.niu.edu/machine/textfcstsound.html"
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set hd = ie.document
T1 = ie.document.Title
hd.all.Item("mo")(4).Checked = True
hd.all.Item("ft")(10).Checked = True
hd.getElementById("stn").Value = "LLBG"
Set objInputs = ie.document.getElementsByTagName("input")
For Each ele In objInputs
If ele.Type = "submit" Then
ele.Click
End If
Next
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
T2 = Now
Do While (Now < T2 + TimeValue("0:00:20")) And ie.document.Title = T1
DoEvents
Loop
If ie.document.Title = T1 Then
Debug.Print "failed"
GoTo end_ext
End If
T1 = ie.document.Title
ie.document.Links(0).Click
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
T2 = Now
Do While (Now < T2 + TimeValue("0:00:20")) And ie.document.Title = T1
DoEvents
Loop
If ie.document.Title = T1 Then
Debug.Print "failed"
GoTo end_ext
Else
'Debug.Print "succeeded"
End If
Debug.Print ie.document.body.innerText
end_ext:
ie.Quit
Set hd = Nothing
Set ie = Nothing