How to get value from webpage? - excel

I want to get/input value to webpage.
All my effort so far works until web loading only. I have no knowledge in web. I can't provide the website link as it's an intranet web.
done lin.e 50 is the place where I want to put my input
then click save button
<td valign="top" class="s bgltgray">
<textarea id="txtResponse1" name="txtResponse1" cols="80" rows="3" class="s">done lin.e 50.</textarea>
<input type="submit" id="cmdRespond1" name="cmdRespond1" value="Save" onclick="cmdRespond_click(1);">
<br> Latest Response By: samyvelu, On: 10/23/2017
</td>

You can try this. Can't really test it since i dont have the url, but this code have worked on another url just without the textarea Tag name
Sub IEtest()
Dim ie As Object
Dim i, x As Integer
Dim objElement As Object
Dim objCollection As Object
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "" '<--- CHANGE THIS
Do While ie.busy
Application.Wait DateAdd("s", 1, Now)
Loop
Set objCollection = ie.Document.getElementsByTagName("textarea")
i = 0
While i < objCollection.Length
If objCollection(i).Name = "txtResponse1" Then
objCollection(i).Value = "Your input" '<--- CHANGE THIS
End If
i = i + 1
Wend
Set objCollection = ie.Document.getElementsByTagName("input")
i = 0
While i < objCollection.Length
If objCollection(i).Type = "submit" And objCollection(i).Name = "cmdRespond1" Then
Set objElement = objCollection(i)
End If
i = i + 1
Wend
objElement.Click
End With
End Sub

There are ids present. Use those as they are the fastest selector method. Using InternetExplorerMedium object
With ie.document
.getElementById("txtResponse1").value = "yourValue"
.getElementById("cmdRespond1").Click '.Submit
End With

Related

Web page navigation reverting back to page 1

I am pulling some data of yellowpages, which is pulling off fine. However my issue is around the page navigation. Although It navigates fine from page 1 to 2 when it trys to navigate to page 3 my code goes back to page 1 and extracts the data again. The data extraction is fine the issue is the navigation.
YellowPage.ca
This is what I have identified and I think is the issue, but do not know how to resolve it.
When the page navigates to page 2, the class for the 'emptyPageButton' changes to the same class to navigate to the NEXT PAGE, so instead of going forward to the next page, which would be page 3, it goes back to page 1. If I stated that 10 pages should be extracted it will extract each page 1 + 2 five times each as it will keep going back and forth between the two pages.
I have made several attempts, but they do not work. I can get as far as page2 and then it goes back to page 1
WITH CLASS works up to page 2 then goes back to page 1
''' Searches Number of Pages entered in Sheet20 rage J9
If pageNumber >= Replace(Worksheets("Sheet20").Range("J9").Value, "", "+") Then Exit Do
Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton ")(0)
'Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton ")(1)
'Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton ")(0).children (0)
'Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton ")(1).children (0)
'Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton ")(1).children (1)
'Set nextPageElement = HTML.getElementsByClassName("view_more_section_noScroll ")(0).getElementsByTagName("a")(1)
If nextPageElement Is Nothing Then Exit Do
nextPageElement.Click 'next web page
Application.Wait Now + TimeValue("00:00:05")
WITH QUERY SELECTOR works up to page 2 then goes back to page 1
''' Searches Number of Pages entered in Sheet20 rage J9
If pageNumber >= Replace(Worksheets("Sheet20").Range("J9").Value, "", "+") Then Exit Do
Set nextPageElement = HTML.querySelector(".view_more_section_noScroll .pageButton")
If Not nextPageElement Is Nothing Then
nextPageElement.Click
Application.Wait Now + TimeValue("00:00:05")
Else:
Exit Do
End If
Snippet for page1
<div class="view_more_section_noScroll">
<div class="emptyPageButton"></div>
<span class="pageCount">
<span class="bold">
1 /
</span>
<span class="">
37</span>
</span>
<a href="/search/si/2/car+dealership/Toronto+ON" data-analytics="{"event_name":"click - load_more - Serp ","lk_se_id":"f32f0ee7-8492-46dd-87da-7b621c162879_Y2FyIGRlYWxlcnNoaXA_VG9yb250byBPTg","lk_name":"next_serp"}"
class="ypbtn btn-theme pageButton">Next
>></a>
</div>
Snippet for page2 and beyond
<div class="view_more_section_noScroll">
<a href="/search/si/1/car+dealership/Toronto+ON" data-analytics="{"event_name":"click - previous_page - Serp ","lk_se_id":"f32f0ee7-8492-46dd-87da-7b621c162879_Y2FyIGRlYWxlcnNoaXA_VG9yb250byBPTg","lk_name":"previous_serp"}"
class="ypbtn btn-theme pageButton"><< Previous</a>
<span class="pageCount">
<span class="bold">
2 /
</span>
<span class="">
37</span>
</span>
<a href="/search/si/3/car+dealership/Toronto+ON" data-analytics="{"event_name":"click - load_more - Serp ","lk_se_id":"f32f0ee7-8492-46dd-87da-7b621c162879_Y2FyIGRlYWxlcnNoaXA_VG9yb250byBPTg","lk_name":"next_serp"}"
class="ypbtn btn-theme pageButton">Next
>></a>
</div>
QUESTION, Can someone advise what the correct class or querySelector is for the navigation?
Results
As aways thanks in advance.
'''########################## UPDATED THUR 8/4/2021 #####################
The full code is large, I have reduced the code a lot to make it much easier to read as the ONLY ISSUE is the page navigation. This code should give you and idea of what i am trying to do. Currently it overides previous extracted results, I have deleted something in the code by error, please ignore this for now as ONLY THE PAGE NAVIGATION IS AN ISSUE
Private Sub YellowPagesCa()
Dim HTML As htmlDocument
Dim objIE As Object
Dim result As String 'string variable that will hold our result link
Dim pageNumber As Long ' page no.
Dim nextPageElement As Object 'page element
Dim HtmlText As Variant ' for html data
Dim wsSheet As Worksheet ' WorkSheet
Dim wb As Workbook
Dim sht As Worksheet
Set wb = ThisWorkbook
Set wsSheet = wb.Sheets("YellowPages")
Set sht = ThisWorkbook.Worksheets("YellowPages")
'+++++ Internet Explorer ++++++
Set objIE = New InternetExplorer 'initiating a new instance of Internet Explorer and asigning it to objIE
objIE.Visible = True
objIE.navigate "https://www.yellowpages.ca/search/si/1/car+dealer/Toronto+ON"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop 'wait here a few seconds while the browser is busy
Set HTML = objIE.document
Set elements = HTML.getElementsByClassName("listing_right_section")
For Each element In elements
DoEvents
''' Element 1
If element.getElementsByClassName("listing__name--link listing__link jsListingName")(0) Is Nothing Then
wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
Else
HtmlText = element.getElementsByClassName("listing__name--link listing__link jsListingName")(0).href
wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText
End If
'End If
Next element
Do
'''############### PAGE NAVIGATION ##############
'Searches Number of Pages entered in
If pageNumber >= 5 Then Exit Do 'Replace(Worksheets("Sheet20").Range("J9").Value, "", "+") Then Exit Do
Set nextPageElement = HTML.querySelector(".view_more_section_noScroll .pageButton")
' Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton ")(0)
If Not nextPageElement Is Nothing Then
nextPageElement.Click
Application.Wait Now + TimeValue("00:00:05")
Else:
Exit Do
End If
Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Loop
Set HTML = objIE.document
pageNumber = pageNumber + 1
Loop
objIE.Quit ' end and clear browser
Set objIE = Nothing
Set HTML = Nothing
Set nextPageElement = Nothing
Set HtmlText = Nothing
Set element = Nothing
Complete.show
'End If
End Sub
You could loop while
ie.document.querySelectorAll(".pageCount + a").Length <> 0
and
click the next button inside that loop with:
ie.document.querySelector(".pageCount + a").click
or
ie.Navigate2 ie.document.querySelector(".pageCount + a").href
This will terminate when there is no more next button.
Alternatively, extract the page count from the first page and loop to that number of pages, substituting the current page number into the url (e.g. replacing 1 with 2 to get page 2)
Option Explicit
Public Sub PrintSomeInfo()
Dim ie As SHDocVw.InternetExplorer, re As Object
Set ie = New SHDocVw.InternetExplorer
Set re = CreateObject("VBScript.RegExp")
With re
.Global = False
.MultiLine = False
.Pattern = "(si\/)(\d+)(\/)"
End With
With ie
.Visible = True
.Navigate2 "https://www.yellowpages.ca/search/si/1/car+dealership/Toronto+ON"
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
Dim pageCount As Long, i As Long
pageCount = CLng(.document.querySelector(".pageCount .bold + span").innerText)
'already on page one so just loop from 2 to pageCount
For i = 2 To pageCount
.Navigate2 re.Replace(.document.url, "$1" & CStr(i) & "$3")
While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
'do something with new page
Next
Stop
.Quit
End With
End Sub
Regex:
The regex pattern matches 3 groups in the url and then substitutes the second group, the current page number, with the new page number:
Thanks to QHarr answer I was able to fix the issue by using parts of it. I have used my Class and QuerySelector code with parts of QHarr QuerySelector answer. I can now navigate the pages fine.
Do
' Searches Number of Pages entered in Sheet20 J9
If pageNumber >= Replace(Worksheets("Sheet20").Range("J9").Value, "", "+") Then Exit Do
'Set nextPageElement = HTML.querySelector(".view_more_section_noScroll .pageButton")
Set nextPageElement = HTML.getElementsByClassName("ypbtn btn-theme pageButton")(0) '' using class and NOT QuerySelector here
If Not nextPageElement Is Nothing Then
nextPageElement.document.querySelector(".pageCount + a").Click ''NEW PART
Application.Wait Now + TimeValue("00:00:05")
Else:
Exit Do
End If

How to submit login credentials?

This is relating to the submit button of the login screen
HTML:
<TD background=/frontend/images/greenback.gif width=302><INPUT type=submit value="Login now" name=submit> </TD>
I enter the username and password into the box but the script stops at .Submit
Sub GetTable()
'Kills any open IE windows.
On Error GoTo Ignore
Call IE_Sledgehammer
Ignore:
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Dim UserName As String, Password As String
'Create anew instance of ie
Set ieApp = New InternetExplorer
'Debugging
ieApp.Visible = True
'Opening this page prompts login screen
ieApp.Navigate "CANNOT SHARE, INTERNAL WORK SITE"
'When busy - wait
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'Pop up window
On Error GoTo skip_Popup
ieApp.Document.all.item("submitBn").Focus
SendKeys "~"
skip_Popup:
'Login script
On Error GoTo Skip_Login
Set ieDoc = ieApp.Document
'fill in the login form – View Source from your browser to get the control names
With ieDoc.forms(0)
.UserName.Value = "test1"
.Password.Value = "test2"
.Submit
End With
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
Skip_Login:
'Copy page Info
Set ieDoc = ieApp.Document
Set ieTable = ieDoc.all.item
'Copy Paste the page
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
'Location of data
Sheets("Raw Data").Range("E2").PasteSpecial "text"
End If
'Delete any form controls that make it into the sheet
Sheets("Raw Data").DrawingObjects.Delete
'Kills ALL IE windows
Call IE_Sledgehammer
Set ieApp = Nothing
End Sub
Also this is not critical, how do I just select the table on the page and not everything else? It doesn't have a name so I am stuck with this one also.
HTML:
<table cellspacing="1" cellpadding="2" align="center" border="0" width="400">
Try using attribute = value css selector
ie.document.querySelector("[name=submit]").click
For your table your best bet is to locate it by it's relationship to other elements/attributes. Impossible to advise further without seeing more html. Failing that if there is a unique attribute or attribute=value in that table (not present in other tables) then combine that to id the table
e.g.
ie.document.querySelector("table[width='400']")
This is a less robust method.
I tested your code and I am able to produce the issue.
As an alternative, you can try to loop through input elements and try to find the submit and click it.
Set objCollection = ieApp.document.getElementsByTagName("input")
i = 0
While i < objCollection.Length
If objCollection(i).Type = "submit" And _
objCollection(i).Name = "submit" Then
objCollection(i).Click
End If
i = i + 1
Wend

VBA Internet explorer script only works 50% of the time

I have a script on VBA that loads up a site, copies data & pastes it on a hidden page. It has worked before but I have to run it about 20 times to get it to do what I want it to do. The errors are very inconsistent and I am debating if I should proceed with this as I need at least a 95% success rate.
Majority of the time the data is not copied correctly & the page is blank, the script finishes with out error but nothing happens.
The other time the script fails is on Set ieTable = ieDoc.all.item -- Do While ieApp.Busy: DoEvents: Loop -- Set ieDoc = ieApp.Document
As you can see, just to be able to check where the errors are occurring I have plagued everything with message prompts.
Sub Pull_Data()
'Kills ALL IE windows
On Error GoTo Ignore:
Call IE_Sledgehammer
Ignore:
Dim ieApp As InternetExplorer
Dim ieDoc As Object
Dim ieTable As Object
Dim clip As DataObject
Dim UserName As String, Password As String
Dim SubmitButton
Dim i As Integer
'Create anew instance of ie
Set ieApp = New InternetExplorer
ieApp.Navigate "Intranet site I cannot share"
'Debugging
ieApp.Visible = True
'When busy - wait
On Error GoTo Skip_wait
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
GoTo Login
'Debugging
Skip_wait:
MsgBox ("You skipped the first wait")
Login:
'*****common error*****
Set ieDoc = ieApp.Document
Set SubmitButton = ieDoc.getElementsByTagName("input")
'Login script
With ieDoc.forms(0)
If Err.Number = 424 Then
GoTo skip_login
.UserName.Value = "USERNAME"
.Password.Value = "PASSWORD"
SubmitButton(i).Click
End If
End With
GoTo wait
'Debugging
skip_login:
MsgBox ("You skipped the login")
'When busy - wait
wait:
On Error GoTo Skip_waiting
Do While ieApp.Busy: DoEvents: Loop
Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
GoTo Copypaste
Skip_waiting:
MsgBox ("You skipped the second wait")
'Copy&paste script
Copypaste:
Set clip = New DataObject
Set ieTable = ieDoc.all.item
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
Sheets("Raw Data").Range("E2").PasteSpecial "Unicode Text"
'Kills all activeX/controls copied from ieDoc.all.item
Sheets("Raw Data").DrawingObjects.Delete
'Kills ALL IE windows
On Error GoTo Ignored:
Call IE_Sledgehammer
Ignored:
End Sub
I do know about the pull data from web option which was my goto on this stuff, but since our office has changed its security settings, its made that option impossible. Other than this, I cannot think of a way to pull data from a click of a button.
Is this option worth it? For anyone with experience with this, Can you tell me if this option is reliable? I cannot for the life of me work out why this is failing.
HTML:
<html><head>
<title>
Open Questions Summary
</title>
<link rel="stylesheet" href="/styles.css" type="text/css">
</head>
<body bgcolor="#FFFFFF">
<table cellspacing="1" cellpadding="2" align="center" border="0" width="400">
<tbody><tr>
<td colspan="2">
Customer Sector:
<form method="get" action="INTERNAL WORK SITE">
<select name="strCustomerType">
<option value="residential" selected="selected">Residential</option>
<option value="business">Business</option>
</select>
<input name="soobmit" value="Submit" type="submit">
</form></table>
From your code and description, it seems that you want to fill value into the textbox and handle the dropdownlist, I suggest you could refer to the following code, they all work well on my machine:
Sub LoginViaBrowser()
Dim IE As Object
Dim Dc_Usuario As String
Dim Dc_Senha As String
Dim Dc_URL As String
Dim txtNam As Object, txtPwd As Object
Dc_Usuario = "user#email.com"
Dc_Senha = "pass"
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_Usuario
IE.Document.getElementById("uPwd").Value = Dc_Senha
IE.Document.getElementById("Loginning").Click
End With
Set IE = Nothing
End Sub
Handle dropdown list:
Public Sub ClickTest()
Dim ie As Object, evtChange As Object
Dim item As Object
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate2 "<the website url>"
While .Busy Or .readyState <> 4: DoEvents: Wend
Set evtChange = .Document.createEvent("HTMLEvents")
evtChange.initEvent "change", True, False
'get the select element. Please note the index, it is starting from 0.
Set item = ie.Document.getElementsByTagName("select")(0)
expCcy = "EUR"
'Set the Expression Currency
For Each o In item 'Sets Expression Currency
If o.Value = expCcy Then
o.Selected = True
o.dispatchEvent evtChange
Exit For
End If
Next
End With
End Sub
More detail information, please check the following threads: Textbox related thread and DropDownList related thread.

How can I set a value of a ComboBox on a website?

I've been trying to write some code that logs in into a website, while I can set the values of "login" or "password", I can't set the value of the "empresa" field, as it is a combobox.
the login page is in the image on this link: https://i.stack.imgur.com/3bk6B.png
When i Inspect object on the website, the "Empresa" field gives me this:
<div id="cmbProject_cmb" class="RadComboBox RadComboBox_" style="border-style:None;font-size:18px;width:100%;white-space:normal;background-color:transparent;">
<table summary="combobox" style="border-width:0;border-collapse:collapse;width:100%" class="rcbFocused">
<tbody><tr class="rcbReadOnly">
<td class="rcbInputCell rcbInputCellLeft" style="width:100%;"><input name="cmbProject$cmb" type="text" class="rcbInput radPreventDecorate" id="cmbProject_cmb_Input" value="Empresa" readonly="readonly" style="color:Black;font-size:18px;" autocomplete="off"></td><td class="rcbArrowCell rcbArrowCellRight"><a id="cmbProject_cmb_Arrow" style="overflow: hidden;display: block;position: relative;outline: none;">select</a></td>
</tr>
</tbody></table><input id="cmbProject_cmb_ClientState" name="cmbProject_cmb_ClientState" type="hidden" autocomplete="off" value="{"logEntries":[],"value":"WTM - PROD|1","text":"WTM - PROD","enabled":true,"checkedIndices":[],"checkedItemsTextOverflows":false}">
</div>
The code i've been using is as follows
Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://prodweb-votorantim.mc1.com.br/WTM/aspx/Login.aspx"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.document
HTMLDoc.all.txtUserName_txt.Value = "login"
HTMLDoc.all.txtPassword_txtPass.Value = "password"
HTMLDoc.all.cmbProject.Value = "WTM - PROD"
For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
Err_Clear:
Resume Next
End Sub
You can use javascript to set value
Option Explicit
'VBE > Tools > References: Microsoft Internet Controls
Public Sub Login()
Dim ie As New InternetExplorer
With ie
.Visible = True
.Navigate2 "https://prodweb-votorantim.mc1.com.br/WTM/aspx/Login.aspx"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("#txtUserName_txt").Value = "bob.builder#web.net"
.querySelector("#txtPassword_txtPass").Value = "topSecret"
.parentWindow.execScript "document.querySelector('#cmbProject_cmb_Input').value = 'WTM-PROD';"
.querySelector("#btnLogin_input").Click
End With
Stop ' <delete me later
.Quit
End With
End Sub

VBA Set Dropdown value

I have a macro that I have written in excel and I have navigated to a webpage using "ActiveWorkbook.FollowHyperlink", which works just as I need it!
However, I now need to update a dropdown menu on that webpage.
I have an ID for the dropdown and each selection obviously has a value. I want to set the selected option using the value, which I have in the excel sheet.
I am struggling because I don't know how to access elements on the page, once opened using .FollowHyperlink.
After .FollowHyperlink is the webpage then active, is there something like ActiveWebPage.getElementById?
Appreciate any help.
Mike
what you want to do is use com automation to call an instance of internet explorer and navigate to the page in question, this will give you the document model, from there you can do most anything, see IE (Internet Explorer) Automation using Excel VBA
Sample VBA follows
Private Sub IE_Autiomation()
Dim i As Long
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.Navigate "http://www.excely.com/"
' Statusbar
Application.StatusBar = "www.excely.com is loading. Please wait..."
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
' Find 2 input tags:
' 1. Text field
' <input type="text" class="textfield" name="s" size="24" value="" />
'
' 2. Button
' <input type="submit" class="button" value="" />
Application.StatusBar = "Search form submission. Please wait..."
Set objCollection = IE.document.getElementsByTagName("input")
i = 0
While i < objCollection.Length
If objCollection(i).Name = "s" Then
' Set text for search
objCollection(i).Value = "excel vba"
Else
If objCollection(i).Type = "submit" And _
objCollection(i).Name = "" Then
' "Search" button is found
Set objElement = objCollection(i)
End If
End If
i = i + 1
Wend
objElement.Click ' click button to search
' Wait while IE re-loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
' Show IE
IE.Visible = True
' Clean up
Set IE = Nothing
Set objElement = Nothing
Set objCollection = Nothing
Application.StatusBar = ""
End Sub

Resources