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.
Related
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
I'm very new to work with IE in vba so it is hard for me sometimes to rectify any mistake I make while writing any code to scrape data from web. I've written some code to click on each video links out of 20 links under the caption Microsoft computer training videos available in it's front page. I expect to click each links then navigate back and repeat the process until all the links are clicked. The class names and tag names I've defined in my scraper is accurate. All i need to do is perform the process in the right way. At this moment my scraper is clicking the last link of the 20 links and get stuck there where it reaches but don't navigate back.
This is what I've written so far.
Sub clicking_links()
Const surl As String = "http://www.wiseowl.co.uk/videos/"
Dim IE As New InternetExplorer, iedoc As HTMLDocument
Dim posts As Object
With IE
.Visible = True
.navigate surl
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = IE.document
End With
For Each posts In iedoc.getElementsByClassName("woVideoListDefaultSeriesTitle")
posts.getElementsByTagName("a")(0).Click
Next posts
End Sub
Try the following:
Sub clicking_links()
Const surl As String = "http://www.wiseowl.co.uk/videos/"
Dim newurl as String
Dim IE As New InternetExplorer, iedoc As HTMLDocument
Dim posts As Object
Dim t As Long, i As Long
With IE
.Visible = True
.navigate surl
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = .document
For Each posts In iedoc.getElementsByClassName("woVideoListDefaultSeriesTitle")
t = t + 1 'count the number of posts
Next posts
For i = 1 To t
Debug.Print i
newurl = iedoc.getElementsByClassName("woVideoListDefaultSeriesTitle")(i - 1).getElementsByTagName("a")(0).href
Debug.Print newurl
.navigate newurl
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = .document
'here do your stuff within the new url
.navigate surl 'back to old url
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = .document
Next i
End With
End Sub
On this site I am able to select the country and language from dropdown menu but when I click on "Complete new application form" button. It says fields are empty.
Any help would be appreciated.
Sub Test()
strURL = "https://visa.kdmid.ru/PetitionChoice.aspx"
With ie
.Visible = True
.navigate strURL
While .Busy
DoEvents
Wend
Set html = .document
'Country where you will apply for visa.
Set ctY = html.getElementById("ctl00$phBody$Country")
For i = 1 To ctY.Options.Length
If ctY.Options(i).Text = "NETHERLANDS" Then
ctY.selectedIndex = i
Exit For
End If
Next i
'Select Language
Set lnG = html.getElementById("ctl00$phBody$ddlLanguage")
For i = 1 To lnG.Options.Length
If lnG.Options(i).Text = "ENGLISH" Then
lnG.selectedIndex = i
Exit For
End If
Next i
'Click I have read instructions check box
html.getElementById("ctl00$phBody$cbConfirm").Click
'Click apply button
Set btnGo = html.forms(0).all("ctl00$phBody$btnNewApplication")
btnGo.Click
End With
End Sub
So you are on the right track but if you look at the HTML of the site there are actually two elements with the country selection- you got the first one, 'ctl00_phBody_Country', but this is actually just the drop down, and the actual selected value is stored in 'ctl00_phBody_cddCountry_ClientState'... the language section has similar structure. Lastly the accepted value is not just the country name you see in the drop down, it is actually a combination of a country code from the drop down and the country name....
See below for sample code:
Public Sub Test()
Dim IE As InternetExplorer
Dim HTMLDoc As HTMLDocument
Dim countryStr As String
Dim countryObj As HTMLObjectElement
Dim countryCodes As IHTMLElementCollection
Dim codeCounter As Long
Dim languageStr As String
Dim languageObj As HTMLObjectElement
Dim languageCodes As IHTMLElementCollection
countryStr = "Netherlands"
languageStr = "English"
Set IE = New InternetExplorer
With IE
.Visible = False
.Navigate "https://visa.kdmid.ru/PetitionChoice.aspx?AspxAutoDetectCookieSupport=1"
While .Busy Or .ReadyState <> READYSTATE_COMPLETE: Wend
Set HTMLDoc = IE.document
End With
Set countryObj = HTMLDoc.getElementById("ctl00_phBody_cddCountry_ClientState")
Set countryCodes = HTMLDoc.getElementById("ctl00_phBody_Country").getElementsByTagName("option")
For codeCounter = 0 To countryCodes.Length - 1
If countryCodes(codeCounter).innerText = UCase(countryStr) Then
countryObj.Value = countryCodes(codeCounter).Value & ":::" & countryCodes(codeCounter).innerText & ":::"
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: Wend
Exit For
End If
Next
Set languageObj = HTMLDoc.getElementById("ctl00_phBody_cddLanguage_ClientState")
Set languageCodes = HTMLDoc.getElementById("ctl00_phBody_ddlLanguage").getElementsByTagName("option")
For codeCounter = 0 To languageCodes.Length - 1
If languageCodes(codeCounter).innerText = UCase(languageStr) Then
languageObj.Value = languageCodes(codeCounter).Value & ":::" & languageCodes(codeCounter).innerText & ":::"
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: Wend
Exit For
End If
Next
HTMLDoc.getElementById("ctl00$phBody$cbConfirm").Click
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: Wend
HTMLDoc.getElementById("ctl00_phBody_btnNewApplication").Click 'Launch Form
IE.Quit
Set IE = Nothing
End Sub
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
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