Copy content of the last popup window - excel

I have code to open IE, login with username/password, tick some checkboxes, click button and open a report on a pop up window.
I am trying to copy the content of the pop up window to an Excel sheet. The code that deals with the pop up window doesn't detect the url.
Sub MyRosterApps()
Dim MyHTML_Element As IHTMLElement
Dim HTMLdoc As HTMLDocument
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim objIE As InternetExplorer, t As Date, nodeList As Object, i As Long
Dim ieIEWindow As SHDocVw.InternetExplorer
Dim y As Integer
Const MAX_WAIT_SEC As Long = 5
'Ignore Errors
On Error GoTo Err_Clear
MyURL = "Not a public URL"
Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
'Wait till finished
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
'Enter user / password
HTMLdoc.all.txtUsername.Value = "username" ' Eneter your email id here
HTMLdoc.all.txtPassword.Value = "password" 'Enter your password here
HTMLdoc.all.Item("btnLogin").Click
For Each MyHTML_Element In HTMLdoc.getElementsByName("btnLogin")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
Do
'Wait till finished
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
HTMLdoc.all.Item("ucSkillsPicker_lstSkills_35").Click
HTMLdoc.all.Item("btnShowReport").Click
' The Pop Up windows opens
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document
' Until here is works fine
' Trying to deal with the Pop Up windows
With objIE
.Visible = True
' I am trying to get the active window url which is the pop up
.navigate ieIEWindow.LocationURL
Do While .Busy = True Or .readyState <> 4: DoEvents: Loop
t = Timer
Do
DoEvents
On Error Resume Next
' Go thru DIV classes and find these two oReportCell .a71
Set nodeList = .document.querySelectorAll("#oReportCell .a71")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While nodeList Is Nothing
If Not nodeList Is Nothing Then
'Paste the value found in DIV classes in Sheet1
With ThisWorkbook.Worksheets("Sheet1")
For i = 0 To nodeList.Length - 1
.Cells(1, i + 1) = nodeList.Item(i).innerText
Next
End With
End If
.Quit
End With
Err_Clear:
If Err <> 0 Then
'Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub
This code below is separate from above. If I run just like this it does what I need. Of course, I have to paste the targeted window url.
.navigate "url of the pop up window"
The issue is that the pop up window url expires or something like that.
After some time the page says that I have to go through selecting some check boxes and submit.
Option Explicit
Public Sub GrabLastNames()
Dim objIE As InternetExplorer, t As Date, nodeList As Object, i As Long
Const MAX_WAIT_SEC As Long = 5
Set objIE = New InternetExplorer
With objIE
.Visible = True
' Paste targeted window. In my case is the pop up window
.navigate "url of the pop up window"
Do While .Busy = True Or .readyState <> 4: DoEvents: Loop
t = Timer
Do
DoEvents
On Error Resume Next
Set nodeList = .document.querySelectorAll("#oReportCell .a71")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While nodeList Is Nothing
If Not nodeList Is Nothing Then
With ThisWorkbook.Worksheets("Sheet3")
For i = 0 To nodeList.Length - 1
.Cells(1, i + 1) = nodeList.item(i).innerText
Next
End With
End If
.Quit
End With
End Sub

Related

How To Click On Web Page Image Link?

I tried several different methods to select a radio button or click on the image. There is an onclick task that is to be triggered. I can't automate any further until this opens up.
Sub AirCan()
Dim HTMLInput As MSHTML.IHTMLElement
Dim HTMLButtons As MSHTML.IHTMLElementCollection
Dim HTMLButton As MSHTML.IHTMLElement
Dim doc As MSHTML.HTMLDocument
Dim img As MSHTML.HTMLImg
On Error GoTo Err_Clear
MyURL = "https://XXXXXXXXXX.com/en/XXXXXXXXXXXXX"
Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = MyBrowser.document
HTMLDoc.all.paymentAmount.Value = "111" 'Enter your email id here
HTMLDoc.all.groupPayment.click
Do While MyBrowser.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set allInputs = HTMLDoc.getElementsByTagName("img")
For Each element In allInputs
If element.getAttribute("src") = "/HPPDP/hpp/images/ca_visa.png" Then
element.click
Exit For
End If
Next
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
CODE from the website, clicking the radio button or any of the 3 images will do what I need,

VBA Get webpage Link and Download File to

Is a long time ago to programming VBA. I want to fetch in a web Table all Linked PDF Files in coll um (x). First I have created the logins and navigate to the site to fetch file.
Site table:
Sub goToShopWH()
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim clip As Object
'Table Grapping
Dim ieTable As Object
'create a new instance of ie
'Set ieApp = New InternetExplorer
Set ieApp = CreateObject("InternetExplorer.Application")
'you don’t need this, but it’s good for debugging
ieApp.Visible = True
'assume we’re not logged in and just go directly to the login page
ieApp.Navigate "https://website.com/ishop/Home.html"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents:
Loop
' Login to site
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc '.forms("loginForm_0")
.getElementById("loginField").Value = "username"
.getElementById("password").Value = "Password"
.getElementById("loginSubmit").Click
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'now that we’re in, go to the page we want
'Switsh to search form
ieApp.Navigate "https://website.com/ishop/account/MyAccount,$comp$account$AccountNavigation.orderHistory.sdirect?sp=Saccount%2FOrderHistory"
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
' fillout form
Set ieDoc = ieApp.Document
With ieDoc '.forms("Form_0")
.getElementById("PropertySelection_2").Value = "7"
.getElementById("commtxt").Value = "190055" 'Projekt Nummer oder Text.
.getElementById("Submit_0").Click
End With
Do
DoEvents
Loop Until ieApp.ReadyState = 4
Application.Wait Now + TimeSerial(0, 0, 5)
With ieDoc '.forms("Form_1")
.getElementById("PropertySelection").Value = "3"
.getElementById("PropertySelection").FireEvent ("onchange")
End With
Do
DoEvents
Loop Until ieApp.ReadyState = 4
Application.Wait Now + TimeSerial(0, 0, 5)
End With
Set webpage = ieApp.Document
Set table_data = webpage.getElementsByTagName("tr")
End Sub
Please help my to solve this to get I want import Table to sheet2 and download all PDF in ("Table"),("tbody")(tr)(1 to X),(td)(10),(href).click
I think you are after something like this.
Sub webpage()
Dim internet As Object
Dim internetdata As Object
Dim div_result As Object
Dim header_links As Object
Dim link As Object
Dim URL As String
Set internet = CreateObject("InternetExplorer.Application")
internet.Visible = True
URL = "https://www.google.co.in/search?q=how+to+program+in+vba"
internet.Navigate URL
Do Until internet.ReadyState >= 4
DoEvents
Loop
Application.Wait Now + TimeSerial(0, 0, 5)
Set internetdata = internet.Document
Set div_result = internetdata.getelementbyid("res")
Set header_links = div_result.getelementsbytagname("h3")
For Each h In header_links
Set link = h.ChildNodes.Item(0)
Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1) = link.href
Next
MsgBox "done"
End Sub
Or, perhaps this.
' place your URL in cell L1
Sub HREF_Web()
Dim doc As HTMLDocument
Dim output As Object
Set IE = New InternetExplorer
IE.Visible = False
IE.navigate Range("L1")
Do
'DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set doc = IE.document
Set output = doc.getElementsByTagName("a")
i = 5
For Each link In output
'If link.InnerHTML = "" Then
Range("A" & i).Value2 = link
' End If
i = i + 1
Next
MsgBox "Done!"
End Sub

Using vba to login

I want to use vba to login to a site. This makes it easy for everyone and not everyone has to know the password this way.
However, the site was recently updated and now the code that I used (that was duct taped together from bits and pieces)
`Sub apiweb()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://apiweb.biomerieux.com/login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.document
HTMLDoc.all.login.Value = "xxxx"
HTMLDoc.all.Password.Value = "yyyy"
' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub`
So it used to work that you press a button in excel, the site would open and after a second or 2 the login and password would show up and you'd just press login. Now it only opens the site.
I tried a few things including inspecting the elements, but i'm a novice so I don't really know what to look for or what to do. So any help (and explanation) would be appreciated!
How about this method?
Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://apiweb.biomerieux.com/login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.Document
HTMLDoc.all.signupEmail.Value = "signupEmail"
HTMLDoc.all.signupPassword.Value = "*****"
For Each oHTML_Element In HTMLDoc.getElementsByTagName("signupSubmit")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub
As an aside, hit F12 to see the HTML behind your browser.
Option Explicit
Sub WbClkMe()
Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInput As MSHTML.IHTMLElement
Dim HTMLButton As MSHTML.IHTMLElement
IE.Visible = True
IE.navigate "https://apiweb.biomerieux.com/login"
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = IE.document
Set HTMLInput = HTMLDoc.getElementById("signupEmail") ' This is based on on your website
HTMLInput.Value = "" 'Put the value of Usernamae
Set HTMLInput = HTMLDoc.getElementById("signupPassword") 'This is based on on your website
HTMLInput.Value = "" 'Put the value of Password
Set HTMLButton = HTMLDoc.getElementById("signupSubmit") 'This is based on on your website
HTMLButton.Click
End Sub

Run-time error '424': Object Required IE.Document.GetElementById

I'm trying to auto-complete a form on a website with values of an excel file.
Sub CommandButton1_Click()
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate "https://www.ryanair.com/be/nl/check-in"
End With
Do Until IE.readyState = 4
DoEvents
Loop
IE.document.getElementbyid("username").Value = "resa#connections.be"
End Sub
Thank you for the quick answer! I just made small changes, as I received an error and I work with a button. It works like a charm now!
Public Sub CommandButton1_Click()
Dim ie As New InternetExplorer, t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 10
t = Timer
With ie
.Visible = True
.Navigate2 "https://www.ryanair.com/be/nl/check-in"
While .Busy Or .readyState < 4: DoEvents: Wend
Do
On Error Resume Next
Set ele = .document.getElementById("username")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
If ele Is Nothing Then Exit Sub
ele.Value = "resa#connections.be"
End With
End Sub
Use a timed loop for element to be present
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
'
Public Sub CommandButton1_Click()
Dim ie As New InternetExplorer, t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 10
With ie
.Visible = True
.Navigate2 "https://www.ryanair.com/be/nl/check-in"
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
On Error Resume Next
Set ele = .document.getElementById("username")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
If ele Is Nothing Then Exit Sub
ele.Value = "resa#connections.be"
Stop
.Quit
End With
End Sub

Retrieving a URL from Internet Explorer with VBA

I have written some VBA code in Excel to retrieve the latitude and longitude from a Google Maps URL and paste it into a cell in my worksheet. My problem is in retrieving the URL from internet explorer. Below I have two examples of my code, one macro returns an about:blank as though the object doesn't have the LocationURL property, and the other example seems like it is saving all of my previous searches, so it cycles through all of my previous searches and pastes the very first searches' URL. Example 2 uses a shell suggestion that I found online to reassign the properties to the oIE object. I can get both to slightly work, but neither will do exactly what I need from the macro.
Cell(8,8) is a hyperlink to google maps where I'm searching an address, and Cell(8,9) is where I want to paste the URL after google maps has redirected and has the latitude and longitude in the URL.
Example 1:
Sub CommandButton1_Click()
Dim ie As Object
Dim Doc As HTMLDocument
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate "http://www.google.com/maps?q=" & Range("I7").Value
Do
DoEvents
Loop Until ie.ReadyState = 4
Set Doc = ie.Document
Cells(8, 9).Value = ie.LocationName
End Sub
Example 2:
Sub Macro()
Dim oIE, oShell, objShellWindows, strPath, X
strPath = Cells(8, 8)
Set oIE = CreateObject("InternetExplorer.Application")
'This is to resolve oIE.navigate "about:blank" issue
oIE.Top = 0
oIE.Left = 0
oIE.Width = 500
oIE.Height = 500
oIE.Navigate strPath
Do While oIE.Busy And oIE.ReadyState < 2
DoEvents
Loop
'Reassigning oIE.LocationName & vbCrLf & oIE.LocationURL values after redirect in IE
Set oShell = CreateObject("WScript.Shell")
Set objShellWindows = CreateObject("Shell.Application").Windows
For X = objShellWindows.Count - 1 To 0 Step -1
Set oIE = objShellWindows.Item(X)
If Not oIE Is Nothing Then
If StrComp(oIE.LocationURL, strPath, 1) = 0 Then
Do While oIE.Busy And oIE.ReadyState < 2
DoEvents
Loop
oIE.Visible = 2
Exit For
End If
End If
Cells(8, 9).Value = oIE.LocationURL
Set oIE = Nothing
Next
Set objShellWindows = Nothing
Set oIE = Nothing
End Sub
Thanks,
Andrew
Is this as simple as looping until the document.URL changes? In my timed loop I wait for the string safe=vss in the original page load to disappear.
Option Explicit
Public Sub GetNewURL()
Dim IE As New InternetExplorer, newURL As String, t As Date
Const MAX_WAIT_SEC As Long = 5
With IE
.Visible = True
.navigate2 "http://www.google.com/maps?q=" & "glasgow" '<==Range("I7").Value
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
newURL = .document.URL
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While InStr(newURL, "safe=vss") > 0
Debug.Print newURL
End With
End Sub

Resources