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
Related
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,
I'm trying to use Excel VBA to extract some data from a webpage (https://www.churchofjesuschrist.org/maps/meetinghouses/lang=eng&q=1148+W+100+N). The code I'm using will open Internet Explorer, navigate to the website, and it will extract the top most result. But I can't seem to figure out how to extract the rest of the results (i.e. ward, language, contact name, contact #). Thoughts?
Sub MeethinghouseLocator()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate Sheets("Sheet1").Range("A1").Value
IE.Visible = True
While IE.Busy
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:01"))
IE.document.querySelector("button.search-input__execute.button--primary").Click
Dim Doc As HTMLDocument
Set Doc = IE.document
Application.Wait (Now + TimeValue("0:00:01"))
'WardName
Dim aaaaFONT As String
aaaaFONT = Trim(Doc.getElementsByClassName("location-header__name ng-binding")(0).innerText)
Sheets("Sheet1").Range("D6").Value = aaaaFONT
Application.Wait (Now + TimeValue("0:00:01"))
'Language
Dim aaabFONT As String
aaabFONT = Trim(Doc.getElementsByClassName("location-header__language ng-binding ng-scope")(0).innerText)
Sheets("Sheet1").Range("E6").Value = aaabFONT
'Click 1st Link
IE.document.getElementsByClassName("location-header__name ng-binding")(0).Click
Application.Wait (Now + TimeValue("0:00:01"))
'Contact Name
Dim aaacFONT As String
aaacFONT = Trim(Doc.getElementsByClassName("maps-card__group maps-card__group--inline ng-scope")(2).innerText)
Sheets("Sheet1").Range("H6").Value = aaacFONT
'Contact Name Function
Range("F6").Select
ActiveCell.FormulaR1C1 = _
"=LEFT(RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3),FIND(RIGHT(RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3),LEN(RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3))-FIND(CHAR(10),RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3))),RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3))-1)"
'Contact Phone Number
Dim aaadFONT As String
aaadFONT = Trim(Doc.getElementsByClassName("phone ng-binding")(0).innerText)
Sheets("Sheet1").Range("G6").Value = aaadFONT
IE.Quit
End Sub
Most of your code works actually so I'm not sure what issue are you facing but you didn't account for the loading after clicking each link so I have added While loop to check for its Ready and ReadyState property before continuing.
EDIT: The code now loops through all the wards listed in the result, the idea is to keep the first IE at the result page and pass the URL of the ward and the input row to sub ExtractWard where it will open another IE, navigate to the given URL and extract the ward details.
Sub MeethinghouseLocator()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate Sheets("Sheet1").Range("A1").Value
IE.Visible = True
While IE.Busy Or IE.readyState <> 4
DoEvents
Wend
IE.document.querySelector("button.search-input__execute.button--primary").Click
While IE.Busy Or IE.readyState <> 4
DoEvents
Wend
Dim Doc As HTMLDocument
Set Doc = IE.document
Application.Wait (Now + TimeValue("0:00:01"))
Dim wardContent As Object
Set wardContent = Doc.getElementsByClassName("maps-card__content")(2)
Dim wardCollection As Object
Set wardCollection = wardContent.getElementsByClassName("location-header")
Dim rowNum As Long
rowNum = 6
Dim i As Long
For i = 0 To wardCollection.Length - 1
With wardCollection(i)
'WardName
Dim aaaaFONT As String
aaaaFONT = Trim(.getElementsByClassName("location-header__name ng-binding")(0).innerText)
Sheets("Sheet1").Cells(rowNum, "D").Value = aaaaFONT
'Language
Dim aaabFONT As String
aaabFONT = Trim(.getElementsByClassName("location-header__language ng-binding ng-scope")(0).innerText)
Sheets("Sheet1").Cells(rowNum, "E").Value = aaabFONT
Dim wardURL As String
wardURL = .getElementsByClassName("location-header__name ng-binding")(0).href
ExtractWard wardURL, rowNum
End With
rowNum = rowNum + 1
Next i
Set Doc = Nothing
IE.Quit
Set IE = Nothing
End Sub
Private Sub ExtractWard(argURL As String, argRow As Long)
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate argURL
IE.Visible = True
While IE.Busy Or IE.readyState <> 4
DoEvents
Wend
Dim Doc As HTMLDocument
Set Doc = IE.document
'Contact Name
Dim aaacFONT As String
aaacFONT = Trim(Doc.getElementsByClassName("maps-card__group maps-card__group--inline ng-scope")(2).innerText)
Sheets("Sheet1").Cells(argRow, "H").Value = aaacFONT
'Contact Name Function
Sheets("Sheet1").Cells(argRow, "F").FormulaR1C1 = _
"=LEFT(RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3),FIND(RIGHT(RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3),LEN(RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3))-FIND(CHAR(10),RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3))),RIGHT(RC[2],LEN(RC[2])-FIND(CHAR(10),RC[2])-3))-1)"
'Contact Phone Number
Dim aaadFONT As String
aaadFONT = Trim(Doc.getElementsByClassName("phone ng-binding")(0).innerText)
Sheets("Sheet1").Cells(argRow, "G").Value = aaadFONT
Set Doc = Nothing
IE.Quit
Set IE = Nothing
End Sub
I need to do a click event on this href link
<li>Report</li>
The PID and KEY change everytime, so I cant use .navigate .. Is there any code to do like a partial match for looking for "*" & "TerminalReport" & "*" and click?
The code is to long to post here, it is telling me to add more details so I will post the code from the begining to the part I'm getting stuck unles I use .navigate
Private Sub CommandButton2_Click()
Dim IE As Object
Dim Dc_User As String
Dim Dc_Pass As String
Dim Dc_URL As String
Dim txtNam As Object, txtPwd As Object
Dc_User = "LOGIN"
Dc_Pass = "PASSWORD"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate "https://www.solarmanpv.com/portal/LoginPage.aspx"
While IE.readyState <> 4
DoEvents
Wend
IE.document.getElementById("uNam").Value = Dc_User
IE.document.getElementById("uPwd").Value = Dc_Pass
IE.document.getElementById("Loginning").Click
Application.Wait Now + #12:00:05 AM#
'THIS IS WHERE I NEED HELP
.navigate "https://www.solarmanpv.com/portal/Terminal/TerminalReport.aspx?pid=20635&key=78775J8"
End With
End Sub
Something like this:
Private Sub CommandButton2_Click()
Dim IE As Object
Dim Dc_User As String
Dim Dc_Pass As String
Dim Dc_URL As String
Dim txtNam As Object, txtPwd As Object
Dim links As Object, link As Object
Dc_User = "LOGIN"
Dc_Pass = "PASSWORD"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate "https://www.solarmanpv.com/portal/LoginPage.aspx"
WaitFor IE
IE.document.getElementById("uNam").Value = Dc_User
IE.document.getElementById("uPwd").Value = Dc_Pass
IE.document.getElementById("Loginning").Click
Application.Wait Now + TimeSerial(0, 0, 5) '5 secs
Set links = .document.getElementById("ct100_cur_item_list").getElementsByTagName("A")
For Each link In links
Debug.Print link.href
If link.href Like "*TerminalReport*" Then
link.Click
Exit For
End If
Next link
End With
End Sub
Sub WaitFor(IE As Object)
While IE.readyState <> 4
DoEvents
Wend
End Sub
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
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