How to use excel vba to click on interactive dialog pop-up? - excel

I am trying to use excel vba to navigate and export data from this website. I am able to click on 2018, 2019 buttons and the setting option, but unable to click the 'export data' option with vba. I attach my code below for your reference.
Option Explicit
Sub GetURLOfFrame()
Dim IE As New SHDocVw.InternetExplorer
Dim webpage As MSHTML.HTMLDocument
IE.Visible = True
IE.navigate "https://www.epa.gov/fuels-registration-reporting-and-compliance-help/rin-trades-and-price-information"
Dim t As Date, ele As Object 'waiting
Const MAX_WAIT_SEC As Long = 10 '<==Adjust wait time
While IE.Busy Or IE.readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = IE.document.getElementById("show-service-popup-dialog")
If Timer - t > MAX_WAIT_SEC Then Exit Do
On Error GoTo 0
Loop While ele Is Nothing
Application.Wait (Now + TimeValue("0:00:10"))
Set webpage = IE.document
Dim wkb As Workbook, wksRIN As Worksheet, wksFrames As Worksheet
Set wkb = ThisWorkbook
Set wksRIN = wkb.Sheets("RIN Trades and Prices")
Dim Frame As MSHTML.IHTMLElement
Set Frame = webpage.getElementsByTagName("iframe")(1)
Dim URL As String
URL = Frame.getAttribute("src") 'storing the link to the frame
IE.navigate URL 'goes to the iframe site
While IE.Busy Or IE.readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = IE.document.getElementById("content")
If Timer - t > MAX_WAIT_SEC Then Exit Do
On Error GoTo 0
Loop While ele Is Nothing
Application.Wait (Now + TimeValue("0:00:10"))
Dim htmlarticle As MSHTML.IHTMLElement
Set htmlarticle = webpage.getElementsByTagName("article")(0)
Application.Wait (Now + TimeValue("0:00:02"))
Dim buttons As MSHTML.IHTMLElementCollection
Set buttons = htmlarticle.getElementsByClassName("lui-buttongroup ng-scope")(0).getElementsByTagName("button")
buttons(buttons.Length - 2).Click 'clicking the second last year
buttons(buttons.Length - 1).Click 'clicking the latest year
Application.Wait (Now + TimeValue("0:00:02"))
Dim SettingButton As MSHTML.IHTMLElement
Set SettingButton = htmlarticle.getElementsByClassName("cl-icon cl-icon--cogwheel cl-icon-right-align")(0)
SettingButton.Click
Dim SettingOptions As MSHTML.IHTMLElementCollection, ExportDataButton As MSHTML.IHTMLElement, button As MSHTML.IHTMLElement
Set SettingOptions = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")
Application.Wait (Now + TimeValue("0:00:05"))
Set ExportDataButton = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")(0)
ExportDataButton.Focus
ExportDataButton.Click
IE.Quit
Set IE = Nothing
End Sub
When I run 'ExportDataButton.Click', nothing seems to happen and I am not sure the reason why. It is also not possible to scrape from the data in the table directly as the the values of innertext of the td are dynamic and changes as you scroll down the table.
Unable to click on 'Export Data'


You have done a good job till the point you needed help. A tip at your code. Declare all variables in the head of the macro. That is more clearly and other people who read your code have a better focus.
I think it would be easier to take all values from the html table. But you've done good groundwork. So I completed your macro in the way you started. I commented on the code I added.
Sub GetURLOfFrame()
Dim IE As New SHDocVw.InternetExplorer
Dim webpage As MSHTML.htmlDocument
IE.Visible = True
IE.navigate "https://www.epa.gov/fuels-registration-reporting-and-compliance-help/rin-trades-and-price-information"
Dim t As Date, ele As Object 'waiting
Const MAX_WAIT_SEC As Long = 10 '<==Adjust wait time
While IE.Busy Or IE.readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = IE.document.getElementById("show-service-popup-dialog")
If Timer - t > MAX_WAIT_SEC Then Exit Do
On Error GoTo 0
Loop While ele Is Nothing
Application.Wait (Now + TimeValue("0:00:10"))
Set webpage = IE.document
Dim wkb As Workbook, wksRIN As Worksheet, wksFrames As Worksheet
Set wkb = ThisWorkbook
Set wksRIN = wkb.Sheets("RIN Trades and Prices")
Dim Frame As MSHTML.IHTMLElement
Set Frame = webpage.getElementsByTagName("iframe")(1)
Dim URL As String
URL = Frame.getAttribute("src") 'storing the link to the frame
IE.navigate URL 'goes to the iframe site
While IE.Busy Or IE.readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = IE.document.getElementById("content")
If Timer - t > MAX_WAIT_SEC Then Exit Do
On Error GoTo 0
Loop While ele Is Nothing
Application.Wait (Now + TimeValue("0:00:10"))
Dim htmlarticle As MSHTML.IHTMLElement
Set htmlarticle = webpage.getElementsByTagName("article")(0)
Application.Wait (Now + TimeValue("0:00:02"))
Dim buttons As MSHTML.IHTMLElementCollection
Set buttons = htmlarticle.getElementsByClassName("lui-buttongroup ng-scope")(0).getElementsByTagName("button")
buttons(buttons.Length - 2).Click 'clicking the second last year
buttons(buttons.Length - 1).Click 'clicking the latest year
Application.Wait (Now + TimeValue("0:00:02"))
Dim SettingButton As MSHTML.IHTMLElement
Set SettingButton = htmlarticle.getElementsByClassName("cl-icon cl-icon--cogwheel cl-icon-right-align")(0)
SettingButton.Click
Dim SettingOptions As MSHTML.IHTMLElementCollection, ExportDataButton As MSHTML.IHTMLElement, button As MSHTML.IHTMLElement
Set SettingOptions = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")
'Application.Wait (Now + TimeValue("0:00:05")) 'Not needed
'The fifth li-tag is "Export data"
Set ExportDataButton = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")(4)
'There is no focus and no click event
'There are the two events keypress and qv-activate
'We must trigger qv-activate to get the download popup
'(See function TriggerEvent to understand what we do here)
Call TriggerEvent(webpage, ExportDataButton, "qv-activate")
'Give the popup time to raise
Application.Wait (Now + TimeValue("0:00:01"))
'I do it like you here, but it's much better to declare all variables in the head of the macro
Dim lastIsDownloadLink As MSHTML.IHTMLElementCollection
'The download link has the css class ng-binding. 101 elements has these css class
'But the code for the popup is generated after clicking 'Export data' at the end of the HTML document
'So we can be sure that the last element with the CSS class contains our searched link
Set lastIsDownloadLink = webpage.getElementsByClassName("ng-binding")
lastIsDownloadLink(lastIsDownloadLink.Length - 1).Click
'Give the server time to generate the document and the IE to show the download button in the footer
Application.Wait (Now + TimeValue("0:00:03"))
'Attention!
'We have to use SendKeys to perform the download!!!
'As long as the macro is running, keep your fingers away from the mouse and keyboard!!!
'
'I've tryed to use the URLDownloadToFile method from the urlmon.dll but that don't work
'I'm sure the server blocks download questions from other applications than that one who
'has generated the download url with. I tryed it also with FireFox and there comes the text,
'that the requestet resource is not available. But the same link works at the same time in IE.
'You will find the download in the download folder of your system
Application.SendKeys ("%{S}")
'IE.Quit
'Set IE = Nothing
End Sub
This is the procedure to trigger a html event:
Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub

Related

VBA for Web Scraping works as Sub but Not as Function

I have written a VBA to scrape the status of a shipment from a cargo tracking site with the help of you guys here. I am trying to convert it to a function. The code works as a sub but does not work as a function. It returns a #Value error. Can someone please tell me what I am doing wrong.
Here is the code as a sub
Sub FlightStat_AFL()
Dim url As String
Dim ie As Object
Dim MAWBStatus As String
Dim MAWBNo As String
MAWBNo = Sheets("Sheet3").Range("H3").Value
'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & MAWBNo
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
'Wait to load dynamic content after IE reports it's ready
'We do that with a fix manual break of a few seconds
'because the whole page will be "reload"
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get the status from the table
MAWBStatus = ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innertext
Debug.Print MAWBStatus
'Clean up
ie.Quit
Set ie = Nothing
End Sub
Here is the code I am trying to make it work as a function.
Function FlightStat_AF(MAWBNo As Range) As String
Dim url As String
Dim ie As Object
Dim MAWBStatus As String
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & MAWBNo
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
'Wait to load dynamic content after IE reports it's ready
'We do that with a fix manual break of a few seconds
'because the whole page will be "reload"
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get the status from the table
MAWBStatus = ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innertext
FlightStat_AF = MAWBStatus
'Clean up
ie.Quit
Set ie = Nothing
End Function

Try the next code, please:
Function FlightStat_AF(cargoNo As Variant) As String
Dim url As String, ie As Object, result As String
url = "https://www.afklcargo.com/mycargo/shipment/detail/" & cargoNo
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = False
.navigate url
Do Until .readyState = 4: DoEvents: Loop
End With
'wait a little for dynamic content to be loaded
Application.Wait (Now + TimeSerial(0, 0, 1))
'Get the status from the table
Do While result = ""
DoEvents
On Error Resume Next
result = Trim(ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innerText)
On Error GoTo 0
Application.Wait (Now + TimeSerial(0, 0, 1))
Loop
ie.Quit: Set ie = Nothing
'Return value of the function
FlightStat_AF = result
End Function

IE Function
You can try this if you really want a range. Usually it should be a string which you can easily change.
You can test the function (2nd procedure) with the first procedure. Just adjust the values in the constants section.
The Code
Option Explicit
Sub getFlightStat()
' Constants
Const wsName As String = "Sheet3"
Const FirstRow As Long = 3
Const CritCol As Variant = "H"
Const ResCol As Variant = "I"
Dim wb As Workbook: Set wb = ThisWorkbook
' Define worksheet.
Dim ws As Worksheet
Set ws = wb.Worksheets(wsName)
' Calculate the row of the last non-blank cell in column 'CritCol'.
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, CritCol).End(xlUp).Row
' Loop through rows and for each value in cell of column 'CritCol',
' write the value retrieved via 'FlightStat_AF' to the cell
' in the same row, but in column 'ResCol'.
Dim i As Long
For i = FirstRow To LastRow
ws.Cells(i, ResCol).Value = FlightStat_AF(ws.Cells(i, CritCol))
Next i
' Inform user.
MsgBox "Data transferred", vbInformation, "Success"
End Sub
Function FlightStat_AF(MAWBNo As Range) As String
Dim url As String
Dim ie As Object
Dim MAWBStatus As String
'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & MAWBNo.Value
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
'Wait to load dynamic content after IE reports it's ready
'We do that with a fix manual break of a few seconds
'because the whole page will be "reload"
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get the status from the table
MAWBStatus = ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innertext
FlightStat_AF = MAWBStatus
'Clean up
ie.Quit
Set ie = Nothing
End Function

Excel VBA Page Pagination, FOR LOOP not working

I am using a For Loop to extract some data from a site, with some code for page navigation through the pages. The problem I am having is that the that after the code navigates to the next page the For Loop is not extracting anything.
What works
The FOR LOOP works fine on the first page
The page pagination code works fine on navigating to the next page/s.
The Problem
*
Once the code has navigated to the next page the FOR LOOP is NOT
working, it will extract NO data.
I cannot work it out
This is what I am working with minus my code as it was a bit too long
Private Sub CommandButton4_Click()
'dimension (declare or set aside memory for) our variables
Dim Html As HTMLDocument
Dim objIE As Object
Dim y As Integer 'integer variable we'll use as a counter
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 lastrow As Long
Dim HtmlText As Variant ' for html data
Dim wsSheet As Worksheet ' WorkSheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set wsSheet = wb.Sheets("Sheet3")
'+++++ Internet Explorer ++++++
Set objIE = New InternetExplorer 'initiating a new instance of Internet Explorer and asigning it to objIE
objIE.Visible = True 'make IE browser visible (False would allow IE to run in the background)
objIE.navigate Sheets("Sheet3").Range("A2").Value & Replace(Worksheets("Sheet3").Range("B2") & Range("C2").Value, " ", "+") 'navigate IE to this web page
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop 'wait here a few seconds while the browser is busy
y = 2
Set Html = objIE.document
Set elements = Html.getElementsByClassName("sresult lvresult clearfix li shic") ' parent CLASS
'FOR LOOP
For Each element In elements
DoEvents
'############################ My code here #################
'COUNTER AND NEXT ELEMENT
y = y + 1
Next element
' #################### START OF Page Navigation will delay ###############
Do
'Number Of Pages to navigate come from sheet3 - D2
If pageNumber >= Replace(Worksheets("Sheet3").Range("D2").Value, " ", "+") Then Exit Do
Set nextPageElement = Html.getElementsByClassName("gspr next")(0)
If nextPageElement Is Nothing Then Exit Do
'Random delay from Max number entered in Sheet3 E2
Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Sheet3").Range("E2").Value))
nextPageElement.Click 'next web page
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'SECOND Random delay from Max number entered in Sheet4 f2
Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Sheet3").Range("F2").Value))
Set Html = objIE.document
pageNumber = pageNumber + 1
Loop
' ########################## End of Page Navigation with Delays ###############
objIE.Quit ' end and clear browser
Set ie = Nothing
Set htmlDoc = Nothing
Set nextPageElement = Nothing
Set div = Nothing
Set link = Nothing
MsgBox "All Done"
End Sub
I tried to add this to the end of "pageNumber = pageNumber + 1" to see if it would work but got not luck
pageNumber = pageNumber + 1
Set elements = Html.getElementsByClassName("sresult lvresult clearfix li shic")
For Each element In elements
DoEvents
Next element

How is it possible to click on a button present in a newly opened tab in internet explorer using VBA?

Here is the code I wrote.
Option Explicit
Public Sub Press_Button()
Dim objIE As SHDocVw.InternetExplorer 'microsoft internet controls (shdocvw.dll)
Dim htmlDoc As MSHTML.HTMLDocument 'Microsoft HTML Object Library
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlColl As MSHTML.IHTMLElementCollection
Dim the_input_elements As MSHTML.IHTMLElementCollection
Dim input_element As MSHTML.HTMLInputElement
Dim IeDoc As MSHTML.HTMLDocument
Dim IeDoc2 As MSHTML.HTMLDocument
Dim input_element2 As MSHTML.HTMLInputElement
Dim the_input_elements2 As MSHTML.IHTMLElementCollection
Set objIE = New SHDocVw.InternetExplorer
With objIE
.Navigate "https://www.ndexsystems.com/fengine/fullservice/en/kerrfinancialsalogin.go?fromLogoff=true" ' Main page
.Visible = 1
Do While .readyState <> 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:02"))
'PART 1: set user name and password
Set htmlDoc = .document
Set htmlColl = htmlDoc.getElementsByTagName("INPUT")
Do While htmlDoc.readyState <> "complete": DoEvents: Loop
For Each htmlInput In htmlColl
If htmlInput.Name = "textbox_password" Then
htmlInput.Value = "***"
Else
If htmlInput.Name = "textbox_id" Then
htmlInput.Value = "***"
End If
End If
Next htmlInput
'PART 2: click login
Set htmlDoc = .document
Set htmlColl = htmlDoc.getElementsByTagName("input")
Do While htmlDoc.readyState <> "complete": DoEvents: Loop
For Each htmlInput In htmlColl
If Trim(htmlInput.Type) = "submit" Then
htmlInput.Click
Exit For
End If
Next htmlInput
'PART 3: Clicks on portfolio management button
Do While .Busy: DoEvents: Loop
Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set IeDoc = .document
Set the_input_elements = IeDoc.getElementsByClassName("big_button")
For Each input_element In the_input_elements
If input_element.href = "javascript:changePageToFrontdoor(false);" Then
input_element.Click
Exit For
End If
Next input_element
'PART 4: Clicks on the 'Advanced search' button
Do While .Busy: DoEvents: Loop
Do Until .readyState = READYSTATE_COMPLETE: DoEvents: Loop
Set IeDoc2 = .document
Set the_input_elements2 = IeDoc2.getElementsByClassName("parent-item")
For Each input_element2 In the_input_elements2
If input_element2.href = "javascript:directToSearch()" Then
input_element2.Click
Exit For
End If
Next input_element2
End With
End Sub
Parts 1, 2 and 3 work perfectly. When I run this macro, it is actually logging in the website with my credentials. In part 3, it is also clicking on the button called "Porfolio management".
However, by clicking on the "portfolio management" button, a new tab is opened with another page of the same website.
On this newly opened page, there is a button called "Advanced search" that I want to click. Here is the HTML code of the button.
Part 4 is not working with this code. It is not giving me any error, it is just not doing anything. I don't know where my error is because I wrote part 4 with the exact same syntax as part 3 and it is only part 3 that is actually running and giving the correct result (clicking on the button).
Maybe the fact that part 3 opens a new tab of this website should imply an additional step that I didn't do in step 4? Since I am not working with the same tab anymore...
Can anyone help me with finding the error?
Thank you :)

If the URL is different every time and you are not available with that URL than you can try to refer steps below.
(1) create object of Shell application.
(2) Than try to count IE windows and loop through it.
(3) After that match the page title with all the tabs and find the desired tab and assigned it to IE object and than you can try to interact with that page.
Example:
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).Document.Location
my_title = objShell.Windows(x).Document.Title
'find the desired page
If my_title Like "Put something from your IE page title here" & "*" Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next
You can modify the above code based on your requirement.
For more information, you can refer link below.
VBA-Excel: Get ALL The Opened Internet Explorer (IE) using Microsoft Excel

VBA code to scrape data not cycling back and forth through a webpage. Also struggling to scrape value

Good Day, I am developing a tool to scrape 'One-Way fees' off various websites. For a particular website, I am at a stage where I can navigate to the correct page but I cannot figure out how to scrape the One-way fee into excel. I also have an issue where I cant seem to click the 'back' button. My code "works" in that if you iterate through the script by pressing F8 you get to where you need to be. It sometimes falls over at the 'carclick.item(x).click part' if you run it normally. Please note that the One-way fee does not always appear. Its most likely to appear when the pickup and dropoff locations are different. The tasks my code needs to execute is as follows:
create the html object, then open the website.
Click the 'return vehicle to a different location' button to allow the code to access different drop-off locations.
I have ignored drop-off/pick-up times and dates for now as they do not affect the one-way fee and the website default values are adequate. (Also, I couldn't get that to work either)
The code then inputs two locations: one for pickup and one for drop-off.
The code then clicks the 'find vehicle' button. The page loads for a while.
This page shows multiple vehicle options. Each car block may have a 'book' or 'request only' button that needs to be clicked (highlighted in blue), after which, a new page opens revealing the one-way fee. (1315.79 in value for the example values in my code)
The code would then need scape the value and paste it into excel along with the car name and car group (usually a letter of the alphabet).
I would then need to click the 'back' button to get back to the vehicle choices and repeat for all car groups.
The tool needs to then repeat this whole process for all location combinations( the one-way fee may be different even for same location trips but in opposite direction). I haven't got this far as I've been struggling. I really need help with step 7 and 8.
Private Sub test1()
Dim appIE As Object
Dim ws As Worksheet
Dim wb As Workbook
Dim a As String
Dim b As String
Dim c As String
Dim x As Integer
Dim d As String
Dim e As Object
Dim l As Object
Dim PickUp As Object
Dim iL As IHTMLElement 'this declares the html object
Dim f As IHTMLElementCollection ' this declares the collection of html objects
Dim post As Object
Dim Ret As Object
Dim entry As Object
Dim pd As Object
Dim backbutton As Object
Dim carclick As Object
Set wb = Application.Workbooks("Hertz")
Set ws = wb.Worksheets("One Way Fees")
Set appIE = CreateObject("InternetExplorer.application")
With appIE
.Navigate "https://www.Hertz.co.za"
.Visible = True
Application.Wait (Now + TimeValue("0:00:03"))
Do While appIE.Busy
DoEvents
Application.Wait (Now + TimeValue("0:00:03"))
Loop
Application.Wait (Now + TimeValue("0:00:03"))
Set g = appIE.document.getElementById("return-location")
g.Click
Application.Wait (Now + TimeValue("0:00:03"))
Do While appIE.Busy
DoEvents
Application.Wait (Now + TimeValue("0:00:03"))
Loop
Application.Wait (Now + TimeValue("0:00:03"))
i = 2 'For i = 2 To 3
With ws
a = 1267
d = 1261
b = "15 - May - 19"
c = "25 - May - 19"
End With
For Each g In appIE.document.getElementsByClassName("return-location")
If g.className = "return-location" Then
g.Click
Exit For
End If
Next g
Do While appIE.Busy And e Is Nothing
DoEvents
Application.Wait (Now + TimeValue("0:00:02"))
Loop
Application.Wait (Now + TimeValue("0:00:02"))
' finds the pickup branch in html and clicks selection
Set e = appIE.document.getElementById("pickup-depot")
For Each O In e.Options
If O.Value = a Then
O.Selected = True
Exit For
End If
Next
Do While appIE.Busy And e Is Nothing
DoEvents
Application.Wait (Now + TimeValue("0:00:03"))
Loop
Application.Wait (Now + TimeValue("0:00:02"))
'sets the return branch and clicks the selection
Set e = appIE.document.getElementById("return-depot")
For Each O In e.Options
If O.Value = d Then
O.Selected = True
Exit For
End If
Next
Do While appIE.Busy And f Is Nothing
DoEvents
Application.Wait (Now + TimeValue("0:00:03"))
Loop
Do While appIE.Busy And l Is Nothing
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
Loop
Application.Wait (Now + TimeValue("0:00:01"))
'Clicking find a vehicle
For Each l In appIE.document.getElementsByTagName("input")
If l.className = "btn" Then
l.Click
Exit For
End If
Next
Application.Wait (Now + TimeValue("0:00:04"))
' On Error Resume Next
Do While appIE.Busy
Application.Wait (Now + TimeValue("0:00:04"))
DoEvents
Loop
'While appIE.Busy Or appIE.readyState < 4: DoEvents: Wend
Set carclick = appIE.document.querySelectorAll(".select-vehicle")
For x = 1 To carclick.Length
carclick.Item(x).Click
'While appIE.Busy Or appIE.readyState < 4: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))
' On Error Resume Next
Do While appIE.Busy
Application.Wait (Now + TimeValue("0:00:02"))
DoEvents
Loop
'This is where I tried to scrape the One-Way Fee value of 1315.79
'ws.Cells(2, 3).Value = appIE.document.querySelector(".sidebar__list- item:nth-of-type(13) span:nth-of-type(1)").innerText
Application.Wait (Now + TimeValue("0:00:02"))
' On Error Resume Next
Do While appIE.Busy
Application.Wait (Now + TimeValue("0:00:02"))
DoEvents
Loop
Set backbutton = appIE.document.querySelectorAll(".back.btn")
backbutton.Click
While appIE.Busy Or appIE.readyState < 4: DoEvents: Wend
Exit For
Next x
End With
End Sub

Looping through a row and copying each cell In a specific procedure

What I have to do is use Excel VBA to:
login to Amazon Seller
open a workbook
loop through a column to get an order number
put it in the search box
hit the search button
go to the order page and extract the data
then have the extracted data go back into a specified column in
another Excel workbook
The loop and order number parts are what I'm currently stumped on. I've figured out this much code as of this moment:
Sub MyAmazonSeller()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim oSignInLink As HTMLLinkElement
Dim oInputEmail As HTMLInputElement
Dim oInputPassword As HTMLInputElement
Dim oInputSigninButton As HTMLInputButtonElement
'InputSearchOrder will be the destination for order numbers taken from the workbook
Dim InputSearchOrder As HTMLInputElement
Dim InputSearchButton As HTMLInputButtonElement
Dim IE As InternetExplorer
Dim AAOrder As Workbook
Dim AAws As Worksheet
MyURL = "https://sellercentral.amazon.com/gp/homepage.html"
Set IE = New InternetExplorer
' Open the browser and navigate.
With IE
.Silent = True
.Navigate MyURL
.Visible = True
Do
DoEvents
Loop Until .ReadyState = READYSTATE_COMPLETE
End With
' Get the html document.
Set HTMLDoc = IE.Document
' See if you have the sign in link is because you are in the main
' page
Set oSignInLink = HTMLDoc.getElementById("signin-button-container")
If Not oSignInLink Is Nothing Then
oSignInLink.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
End If
' Get the email field and the next button
Set oInputEmail = HTMLDoc.getElementById("username")
Set oInputPassword = HTMLDoc.getElementById("password")
' Click the button and wait
oInputEmail.Value = "xxxxxx#xxxxxx.net"
' Get the password field and the sign in button
Set oInputPassword = HTMLDoc.getElementById("password")
Set oInputSigninButton = HTMLDoc.getElementById("sign-in-button")
' Click the button and wait
oInputPassword.Value = "xxxxxxxx"
oInputSigninButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:05"))
Set AAOrder = Application.Workbooks.Open("Z:\Employee Folders\Employee\trackingnumber_sample_spreadsheet.xls")
Set AAws = AAws.Worksheets("PrimeOrdersWithNoFulfillmentRe")
Set InputSearchOrder = HTMLDoc.getElementById("sc-search-field")
'What I'm currently stuck on
InputSearchOrder.Value = "001-7163923-7572632"
Set InputSearchButton = HTMLDoc.getElementsByClassName("sc-search-button")(0)
InputSearchButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
'Was able to add this snippet, but I'm getting an error 13, most likely with
'my e variable. I'm basically trying to do a loop within a loop, extracting 5
'pieces of data and sticking them back into their respective columns in the
'original Excel sheet. The problem comes when scraping the HTML. I'm basically
'trying to get text in the tables which have a few levels and it's frustrating
'me to no end.
With HTMLDoc
Set elems = HTMLDoc.getElementsByTagName("td")
For Each e In elems
If e.innerText Like "*1Z*" Then
Range("D2").Value = e.innerText
End If
Next e
End With
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub

Resources