How To Click On Web Page Image Link? - excel

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,

Related

Trying to click a link in IE using VBA

Trying to work on a Macro to login into a website and then download some data. Currently I am having trouble getting it to click on a link in the site.
Code:
Sub GetHTLMDocuments()
Dim IE As New SHDocVw.InternetExplorerMedium
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInput As MSHTML.IHTMLElement
Dim HTMLButtons As MSHTML.IHTMLElementCollection
Dim HTMLButton As MSHTML.IHTMLElement
IE.Visible = True
IE.navigate "xxx.yyy"
Do While IE.readyState <> READYSTATE_COMPLETE
Application.Wait Now + TimeValue("00:00:03")
DoEvents
Loop
Application.Wait Now + TimeValue("00:00:02")
ShowWindow IE.hwnd, SW_MAXIMIZE
Set HTMLDoc = IE.document
Application.Wait Now + TimeValue("00:00:02")
Set ElementCol = IE.document.getElementById("periods")
For Each btnInput In ElementCol
If btnInput.Value = "selected" Then
btnInput.Click
Exit For
End If
Next btnInput
IE.Quit
End Sub
Here's the html code from the site:
I would like to change the class which state the selected (or unselected) of the "option" element, any idea?
also tried to print all the Elements by class name......
Debug.Print InStr(1, HTMLDoc.body.outerHTML, "periods", vbTextCompare)
Dim dd As Variant
dd = IE.document.getElementsByClassName("periods")(0).innerText
IE.document.querySelector("[title='periods']").Click
For Each link In IE.document.getElementsByTagName("*")
With link
If .innerText = "periods" Then
link.Click
End If
End With
Next

Pushing a button on webpage via vba

So my overall goal is to scrape data from a table that is behind a security wall. I have done the code to launch IE and input the security creditals however the code I have for clicking the Submit button isn't working. The webpage I am working with is:
https://www.myfueltanksolutions.com/validate.asp
I have put the code below:
Private Sub CommandButton1_Click()
Dim i As SHDocVw.InternetExplorer
Set i = New InternetExplorer
i.Visible = True
i.navigate ("https://www.myfueltanksolutions.com/validate.asp")
Do While i.readyState <> READYSTATE_COMPLETE
Loop
Dim idoc As MSHTML.HTMLDocument
Set idoc = i.document
idoc.all.CompanyID.Value = "CompanyID"
idoc.all.UserId.Value = "UserID"
idoc.all.Password.Value = "Password"
Dim ele As MSHTML.IHTMLElement
Dim eles As MSHTML.IHTMLElementCollection
Set eles = idoc.getElementsByTagName("button")
For Each ele In eles
If ele.Name = "btnSubmit" Then
ele.Click
Else
End If
Next ele
End Sub
btnSubmit is not a button, it is an image.
Private Sub CommandButton1_Click()
Dim i As SHDocVw.InternetExplorer
Set i = New InternetExplorer
i.Visible = True
i.navigate ("https://www.myfueltanksolutions.com/validate.asp")
Do While i.readyState <> READYSTATE_COMPLETE
Loop
Dim idoc As MSHTML.HTMLDocument
Set idoc = i.document
idoc.all.CompanyID.Value = "CompanyID"
idoc.all.UserId.Value = "UserID"
idoc.all.Password.Value = "Password"
Dim ele As MSHTML.IHTMLElement
Dim eles As MSHTML.IHTMLElementCollection
'Set eles = idoc.getElementsByTagName("button")
Set eles = idoc.getElementsByTagName("img")
For Each ele In eles
If ele.Name = "btnSubmit" Then
'ele.Click
ele.parentNode.Click ' click the <a> that contains this element
Else
End If
Next ele
End Sub
The submit button is just calling a javascript function, so you could skip finding the button all togeather.
idoc.parentWindow.execScript "submitForm();"

Unable to click on webpage based on attribute results

I am trying to navigate in "https://www.ford.co.uk/shop/price-and-locate/build-and-price-gf3#/catalogID/WAEGB-CE1-2015-B479FiestaCarGBR201950/?code=". I have to select Titanium in the model list. But i am not able to select it. Everytime the list of models will vary based on link.
Below is the code which i have tried.
Sub testcode()
Dim ie As New SHDocVw.InternetExplorer
Dim htmldoc As MSHTML.HTMLDocument
Dim HTMLAs As MSHTML.IHTMLElementCollection
Dim HTMLA As MSHTML.IHTMLElement
ie.Visible = True
ie.navigate "https://www.ford.co.uk/shop/price-and-locate/build-and-price-gf3#/catalogID/WAEGB-CE1-2015-B479FiestaCarGBR201950/?code="
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:03"))
Set htmldoc = ie.document
Set HTMLAs = htmldoc.getElementsByClassName("features-list-item feature-box")
For Each HTMLA In HTMLAs
Debug.Print HTMLA.getAttribute("id"), HTMLA.getAttribute("tabindex")
If HTMLA.getAttribute("id") = "feature-1" And HTMLA.getAttribute("tabindex") = 0 Then
HTMLA.Click
End If
Next HTMLA
Set HTMLAs = Nothing
Set HTMLA = Nothing
End Sub
The result should be webpage loaded and selected the titanium series. Kindly assist me achieve this.
HTMLA itself doesn't seem to have a click handler, but you can click on one of its child elements.
Try this:
If HTMLA.getAttribute("id") = "feature-1" And HTMLA.getAttribute("tabindex") = 0 Then
HTMLA.getElementsByTagName("img")(0).Click
Exit For
End If

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

Copy content of the last popup window

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

Resources