Excel VBA script to prefill online form using IE? - vba

I am in need of assistance. I am trying to write a VBA script that would take the value in column A and place it on an online form in an input element with no ID but the name ("OldUrl"). Then the VBA script would take the value in the adjacent cell in column B and place that in the same form ("digiSHOP") in the input field named ("NewUrl").
The form is on a secure server however I have gotten as far as the window pulling up and the form selected. I am having trouble finding a way to target the input field since they have no ID. Below is my code and thank you for your help.
Sub Redirect()
Dim IE As Object
Dim doc As Object
Dim form As Object
Dim OldURL As Object
Dim NewURL As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "https://...."
Do Until .ReadyState = 4: DoEvents: Loop
Set doc = IE.Document
Set form = doc.forms("digiSHOP")
Set OldURL = doc.getElementById("OldUrl")'Error occurs here. Element has no ID
OldURL.Value = Range("A2")
Set NewURL = doc.getElementById("NewUrl")
NewURL.Value = Range("B2")
form.submit
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With
End Sub
Also I wasn't sure how to target the entire column and loop it therefore the Value is set to the cell A2. This was more to test the script.

Sub Redirect()
Dim IE As Object
Dim doc As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "https://...."
Do Until .ReadyState = 4: DoEvents: Loop
With .Document.forms("digiSHOP")
.elements("OldUrl").Value = Range("A2")
.elements("NewUrl").Value = Range("B2")
.submit
End With
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With
End Sub

Related

How to take value from excel workbook to find something in a web form dropbox

I am working on a web automation project. I have come up to a web drop box to where I have to choose a value. I have a query selector which works fine in doing the job but now I want that query selector to find those values in the drop box which are taken from a cell value of excel sheet.
With .document.querySelector("[value='536']")
.Selected = True
.dispatchEvent evt
End With
Above is the query which works fine. But now I want to replace "536" from cell "A1" .
I have tried to replace ("[value='536']") with ([value='thisWorkbool.sheets.("sheet1").Range(A1).value']") but it shows error.
Option Explicit
Public Sub FillForm()
Dim ie As Object, tool As Workbook
Set tool = ActiveWorkbook
Set ie = CreateObject("InternetExplorer.application")
With ie
.Visible = True
.navigate "https://******.com/"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.getElementById("txtUserName").Value = "09100107801-01"
.getElementById("txtPassword").Value = "Abc#1234"
.getElementById("btnSubmit").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
.navigate "https://***************"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim evt As Object
Set evt = .document.createEvent("HTMLEvents")
evt.initEvent "change", True, False
With .document.querySelector("[value='536']")
.Selected = True
.dispatchEvent evt
End With
end sub
How to put the value from the cell value "A1" of exel sheet in above code.
Something like this should work:
Dim v
v = thisWorkbook.sheets("sheet1").Range("A1").value
With .document.querySelector("[value='" & v & "']")
.Selected = True
.dispatchEvent evt
End With

Unable to make my script stop printing wrong result

I've created a script in vba using IE to fill in few inputs in a webpage in order to reach a new page to check for some items availability based on inputting some values in an inputbox.
To walk you through: what the script is currently doing:
Select Buy Bricks from landing page
Enter age 30 and country United Kingdom and then click on submit button
On the next page, enter the unique identification number for the Lego piece in the Element/design number box to populate result.
My script can satisfy all the requirements stated above. However, when I try with three different numbers, as in 4219725,765467 and 230223 I can see that the one in the middle 765467 doesn't populate any result but It prints the result of it's earlier number.
All the three numbers have been used in a for loop within my script below.
How can I make my script print nothing when there is no result instead of printing wrong result?
Site address
My script so far: (could not kick out hardcoded delay)
Sub GetDetails()
Const timeOut = 10
Dim IE As New InternetExplorer, Html As HTMLDocument
Dim elem As Object, post As Object, inputNum As Variant
Dim ageInput As Object, itm As Object, T As Date
With IE
.Visible = True
.navigate "https://www.lego.com/en-gb/service/replacementparts"
While .Busy Or .readyState < 4: DoEvents: Wend
Set Html = .document
Dim event_onChange As Object
Set event_onChange = .document.createEvent("HTMLEvents")
event_onChange.initEvent "change", True, False
Html.querySelectorAll(".arrow-list-info")(2).Click
Do: Set ageInput = Html.querySelector("input[id*='How old']"): DoEvents: Loop While ageInput Is Nothing
ageInput.innerText = 30
Html.querySelector("[label='United Kingdom").Selected = True
Html.querySelector("select").dispatchEvent event_onChange
Html.querySelector("[ng-click='startFlow()'").Click
While .Busy Or .readyState < 4: DoEvents: Wend
Set Html = .document
For Each inputNum In [{4219725,765467,230223}]
T = Timer
Do: Set post = Html.querySelector("[placeholder='Element/design number']"): DoEvents: Loop While post Is Nothing
post.ScrollIntoView
post.Focus
post.innerText = inputNum
Html.querySelector("button[ng-click='searchItemNumber()']").Click
'Can't kick out this hardcoded delay
Application.Wait Now + TimeValue("00:00:02")
Do
Set elem = Html.querySelector("div.list-item")
If Timer - T > timeOut Then Exit Do
DoEvents
Loop While elem Is Nothing
Set itm = Html.querySelector("h6.title")
If Not itm Is Nothing Then
Debug.Print itm.innerText
Else:
Debug.Print "Found Nothing"
End If
Next inputNum
Stop
End With
End Sub
So this needs tidying up but does it. I got rid of the explicit wait and added a wait for the spinner to disappear. For the no results section I look for an additional element to be present in the html when not found.
Option Explicit
Public Sub GetDetails()
Const timeOut = 10
Dim ie As New InternetExplorer, html As HTMLDocument
Dim elem As Object, post As Object, inputNum As Variant
Dim ageInput As Object, itm As Object, t As Date
With ie
.Visible = True
.navigate "https://www.lego.com/en-gb/service/replacementparts"
While .Busy Or .readyState < 4: DoEvents: Wend
Set html = .document
Dim event_onChange As Object
Set event_onChange = .document.createEvent("HTMLEvents")
event_onChange.initEvent "change", True, False
html.querySelectorAll(".arrow-list-info")(2).Click
Do: Set ageInput = html.querySelector("input[id*='How old']"): DoEvents: Loop While ageInput Is Nothing
ageInput.innerText = 30
html.querySelector("[label='United Kingdom']").Selected = True
html.querySelector("select").dispatchEvent event_onChange
html.querySelector("[ng-click='startFlow()']").Click
While .Busy Or .readyState < 4: DoEvents: Wend
For Each inputNum In [{4219725,765467,230223}]
Do: Set post = .document.querySelector("[placeholder='Element/design number']"): DoEvents: Loop While post Is Nothing
post.Focus
post.innerText = inputNum
html.querySelector("button[ng-click='searchItemNumber()']").Click
Do
Loop While .document.querySelectorAll(".basic-search-btn .icon-spinner-arrows").Length > 0
t = Timer
Do
Set elem = html.querySelector("div.list-item")
If Timer - t > timeOut Then Exit Do
DoEvents
Loop While elem Is Nothing
Set elem = Nothing
Set itm = html.querySelector("h6.title")
If html.querySelectorAll(".alert.alert-info.margin-top.ng-hide").Length = 1 Then
Debug.Print "Found nothing"
Else
Debug.Print itm.innerText
End If
Set itm = Nothing
Next inputNum
ie.Quit
End With
End Sub

Object variable or with block variable not set - error '91'

Sub Two()
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://example.com/market/listings/578080/Sneakers%20(WHITE)"
Do: DoEvents: Loop Until IE.ReadyState = 4
Srd27 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0).innerText
ActiveSheet.Range("D27").Value = Srd27
IE.Navigate "http://example.com/market/listings/578080/Floral%20Shirt%20(Black)"
Do: DoEvents: Loop Until IE.ReadyState = 4
Srd28 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0).innerText
ActiveSheet.Range("D28").Value = Srd28
IE.Navigate "http://example.com/market/listings/578080/Tracksuit%20Top%20(Yellow)"
Do: DoEvents: Loop Until IE.ReadyState = 4
Srd29 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0).innerText
ActiveSheet.Range("D29").Value = Srd29
IE.Navigate "http://example.com/market/listings/578080/School%20Jacket"
Do: DoEvents: Loop Until IE.ReadyState = 4
Srd30 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0).innerText
ActiveSheet.Range("D30").Value = Srd30
IE.Navigate "http://example.com/market/listings/578080/Leather%20Bootcut%20Pants"
Do: DoEvents: Loop Until IE.ReadyState = 4
Srd31 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0).innerText
ActiveSheet.Range("D31").Value = Srd31
IE.Quit
End Sub
If i use F8 key in Visual Basic app it works sometimes. But when I use macros in Excel its saying
'object variable or with block variable not set - error '91''
I have tested it and from what I can see it's that the address "http://steamcommunity.com/market/listings/578080/Sneakers%20(WHITE)" gives you a page saying that the product could not be found.
The method getElementsByClassName generates error because the element you are looking for is not available on the loaded page.
Try something like this:
Sub Two()
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://steamcommunity.com/market/listings/578080/Sneakers%20(WHITE)"
Do: DoEvents: Loop Until IE.ReadyState = 4
on error resume next
Srd27 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0).innerText
on error goto 0
If Srd27 <> "" then
ActiveSheet.Range("D27").Value = Srd27
Else
ActiveSheet.Range("D27").Value = "Product not found"
end if
'repeat for the rest of the code
IE.Quit
End Sub
And of course I am always encouraging to use Option Explicit and declare all variables.
You need to set the object and validate its state before trying to access its properties.
getElementsByClassName()
Returns a collection of objects with the same class attribute value.
Sub Two()
Dim IE As Object, Srd27 As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://steamcommunity.com/market/listings/578080/Sneakers%20(WHITE)"
Do: DoEvents: Loop Until IE.ReadyState = 4
Set Srd27 = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")(0)
If Not Srd27 Is Nothing Then
ActiveSheet.Range("D27").Value = Srd27.innerText
End If
End Sub
Edit:
To get multiple results, you have to loop through the elements collection and get the innerText of each element.
Dim elements As Object, element as Object
Set elements = IE.Document.getElementsByClassName("market_commodity_orders_header_promote")
If Not elements Is Nothing Then
For Each element in elements
Debug.Print element.innerText
Next
End if

Not able to login to a webpage using excel, error 424 object required

I am trying to login to this webpage, https://www.fois.indianrail.gov.in/ecustomer/JSP/QryInsight.jsp
using VBA. Debugging shows me that the VBA throws an error 424 object required when username line is active (apparently it is not able to fill the username data).
Here's the code:
Sub Test()
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate ("https://www.fois.indianrail.gov.in/ecustomer/JSP/QryInsight.jsp")
With ie.document
.getElementById("txtUserId").Value = "ABCDE"
.getElementById("txtPassword").Value = "ABCDE"
.getElementById("submit").Click
End With
End Sub
Can anyone help me with debugging the problem while logging in to the given webpage?
Take a look at the below example:
Option Explicit
Sub Test()
Dim oIE As Object
Set oIE = CreateObject("InternetExplorer.application")
With oIE
.Visible = True
.Navigate ("https://www.fois.indianrail.gov.in/ecustomer/JSP/QryInsight.jsp")
Do While .ReadyState < 4 Or .Busy
DoEvents
Loop
With .Document
Do While .ReadyState <> "complete"
DoEvents
Loop
With .parentWindow.frames("frmCUMain").document
.getElementsByName("txtUserId")(0).Value = "ABCDE"
.getElementsByName("txtPassword")(0).Value = "ABCDE"
.getElementsByName("cmdLogin")(0).Click
End With
End With
End With
End Sub

Use VBA to list all URL address of a web page

I used the below code for loading the web site http://www.flashscore.com/soccer/england/premier-league/results/.
After I found and click on the "Show more matches" link, all the football matches are loaded in the browser.
The below code will give as results only the first half of matches, the events showed before pressing the "Show more matches" link.
My question is how can I list all the events URL adress?
Sub Test_Flashscore()
Dim URL As String
Dim ie As New InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim dictObj As Object: Set dictObj = CreateObject("Scripting.Dictionary")
Dim tRowID As String
URL = "http://www.flashscore.com/soccer/england/premier-league/results/"
With ie
.navigate URL
.Visible = True
Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set HTMLdoc = .document
End With
For Each objLink In ie.document.getElementsByTagName("a")
If Left(objLink.innerText, 4) = "Show" Or Left(objLink.innerText, 4) = "Arat" Then
MsgBox "The link was founded!"
objLink.Click
Exit For
End If
Next objLink
With HTMLdoc
Set tblSet = .getElementById("fs-results")
Set mTbl = tblSet.getElementsByTagName("tbody")(0)
Set tRows = mTbl.getElementsByTagName("tr")
With dictObj
'If if value is not yet in dictionary, store it.
For Each tRow In tRows
'Remove the first four (4) characters.
tRowID = Mid(tRow.ID, 5)
If Not .Exists(tRowID) Then
.add tRowID, Empty
End If
Next tRow
End With
End With
i = 14
For Each Key In dictObj
ActiveSheet.Cells(i, 2) = "http://www.flashscore.com/" & Key & "/#match-summary"
i = i + 1
Next Key
Set ie = Nothing
MsgBox "Process Completed"
End Sub
You need to wait a little while for the rest of the content to load - clicking the link fires off a GET request to the server, so that needs to return content and the content needs to be rendered on the page before you can grab it.
Clicking on that link takes you to fixtures. You can replace all that before dictionary with
.navigate "https://www.flashscore.com/football/england/premier-league/fixtures/"
That is:
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer
With IE
.Visible = True
.navigate "https://www.flashscore.com/football/england/premier-league/fixtures/"
While .Busy Or .readyState < 4: DoEvents: Wend
'other code...using dictionary
'.Quit
End With
End Sub