filling a html auto search box and obtaining the results - html

I am trying to fill in a search box on a web page that as it is filled in it auto searches for the results. The website is https://pcpartpicker.com/products/motherboard/. If you go there and type in a motherboard manufacturer of motherboard name you can see how it begins to narrow down the possible selections. I have code that will fill in the search box but nothing happens.
Sub GetMotherboards()
Dim ie As InternetExplorer
Set ie = New InternetExplorer
Dim doc As HTMLDocument
Dim objText As DataObject
Dim objArticleContents As Object
Dim objLinksCollection As Object
Dim objToClipBoard As DataObject
Dim r As Object
Dim prodRating As String
Dim prodName As String
Dim lngNumberOfVideos As Long
Dim strURL As String
Dim strNewString As String, strStr As String, strTestChar As String
Dim bFlag As Boolean
strURL = "https://pcpartpicker.com/products/motherboard/" ' Range("J5").Value
With ie
.navigate strURL
.Visible = True
Do While .readyState <> 4: DoEvents: Loop
Application.Wait Now + #12:00:02 AM#
Set doc = ie.document
End With
bFlag = False
With doc
Set objArticleContents = .getElementsByClassName("subTitle__form")
Stop
Set ele = .getElementsByClassName("subTitle__form")(0)
Set form = .getElementsByClassName("subTitle__form")(0).getElementsByClassName("form-label xs-inline")(1)
Set inzputz = ele.getElementsByClassName("text-input")(0)
Call .getElementsByClassName("text-input")(0).setAttribute("placeholder", "MSI B450 TOMAHAWK") '.setAttribute("part_category_search", "MSI B450 TOMAHAWK")
End With
End Sub
After reading some posts here (which I now can't find) my thinking is that there is/ are event listeners and functions that need to be included in this code but that is over my head. Could someone please help me figure this out.
Tim Williams has a post here (an answer to a post) which discussed this but now I can't find it.

You can avoid the expense of a browser and perform the same xhr GET request the page does that returns json. You will need a json parser to handle the response.
Json library:
I use jsonconverter.bas. Download raw code from here and add to standard module called JsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime. Remove the top Attribute line from the copied code.
I show a partial implementation which makes requests for different categories and products and uses both full and partial string searches. It is a partial implementation in that I read responses into json objects and also print the json strings but do not attempt to access all items within json object. That can be refined upon more detail from you. For demo puposes I access ("result")("data") which gives you the price and name info. Part of the original response json has html as value for accessor ("result")("html"). This has description info e.g.Socket/CPU with motherboard items.
Option Explicit
Public Sub ProductSearches()
Dim xhr As Object, category As String, items()
Set xhr = CreateObject("MSXML2.XMLHTTP")
category = "motherboard"
items = Array("Gigabyte B450M DS3H", "MSI B450 TOMAHAWK", "random string")
PrintListings items, xhr, category
category = "memory"
items = Array("Corsair Vengeance") 'partial search
PrintListings items, xhr, category
End Sub
Public Function GetListings(ByVal xhr As Object, ByVal category As String, ByVal item As String) As Object
Dim json As Object
With xhr
.Open "GET", "https://pcpartpicker.com/products/" & category & "/fetch/?xslug=&location=&search=" & item, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Set json = JsonConverter.ParseJson(.responseText)("result")("data")
Set GetListings = json
End With
End Function
Public Sub PrintListings(ByRef items(), ByVal xhr As Object, ByVal category As String)
'Partially implemented. You need to decide what to do with contents of json object
Dim json As Object, i As Long
For i = LBound(items) To UBound(items)
Set json = GetListings(xhr, category, items(i))
'Debug.Print Len(JsonConverter.ConvertToJson(json)) ' Len(JsonConverter.ConvertToJson(json)) =2 i.e {} then no results
Debug.Print JsonConverter.ConvertToJson(json) 'demo purposes only
'do something with json
Next
End Sub
Json parsing:
Read about using JsonConverter and parsing json in vba here, here and here.

You need to execute the keyup event after you place your value into your textbox.
You can accomplish this by using the execScript method.
So, after you load the webpage, create a variable for your input/textbox. In the below example, it's tb. Set the .Value property to your search text (which I used "MSI") then fire the keyup event via script.
Dim tb As HTMLInputElement
Set tb = IE.document.getElementById("part_category_search")
tb.Value = "MSI"
IE.document.parentWindow.execScript "$('#part_category_search').keyup()"
I am not overly familiar with jQuery, so this script targets all inputs on the webpage. But I've tested it and it works for your search.
Here was the full code I used in testing if you want to shorten yours:
Dim IE As InternetExplorer
Set IE = New InternetExplorer
IE.Visible = True
IE.navigate "https://pcpartpicker.com/products/motherboard/"
Do While IE.Busy Or IE.readyState < 4
DoEvents
Loop
Dim tb As HTMLInputElement
Set tb = IE.document.getElementById("part_category_search")
tb.Value = "MSI"
IE.document.parentWindow.execScript "$('#part_category_search').keyup()"

Related

VBA Web search button - GetElementsbyClassName

I have a problem with the VBA code.
I would like to open this website: https://www.tnt.com/express/en_us/site/tracking.html and in Shipment numbers search box I would like to put active cells from Excel file. At the beginning I tried to put only a specific text for example: "777777".
I wrote the below code but unfortunately, the search button is empty and there is no error. I tried everything and I have no idea what should I change in my code.
Any clues? Thank you in advance.
HTML:
<input class="__c-form-field__text ng-touched ng-dirty ng-invalid" formcontrolname="query" pbconvertnewlinestocommasonpaste="" pbsearchhistorynavigation="" shamselectalltextonfocus="" type="search">
VBA:
Sub TNT2_tracker()
Dim objIE As InternetExplorer
Dim aEle As HTMLLinkElement
Dim y As Integer
Dim result As String
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://www.tnt.com/express/en_us/site/tracking.html"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Dim webpageelement As Object
For Each webpageelement In objIE.document.getElementsByClassName("input")
If webpageelement.Class = "__c-form-field__text ng-pristine ng-invalid ng-touched" Then
webpageelement.Value = "777"
End If
Next webpageelement
End Sub
You could use the querySelector + class name to find an element.
something like
'Find the input box
objIE.document.querySelector("input.__c-form-field__text").value = "test"
'Find the search button and do a click
objIE.document.querySelector("button.__c-btn").Click
No need to loop through elements. Unless the site allows you to search multiple tracking numbers at the same time.
It seems automating this page is a litte tricky. If you change the value of the input field it doesn' t work. Nothing happen by clicking the submit button.
A look in the dom inspector shows several events for the input field. I checked them out and it seems we need to paste the value over the clipboard by trigger the paste event of the shipping field.
In order for this to work without Internet Explorer prompting, its security settings for the Internet zone must be set to allow pasting from the clipboard. I'm using a German version of IE, so I have problems explaining how to find the setting.
This macro works for me:
Sub TNT2_tracker()
Dim browser As Object
Dim url As String
Dim nodeDivWithInputField As Object
Dim nodeInputShipmentNumber As Object
Dim textToClipboard As Object
'Dataobject by late binding to use the clipboard
Set textToClipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
url = "https://www.tnt.com/express/en_us/site/tracking.html"
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Manual break for loading the page complitly
'Application.Wait (Now + TimeSerial(pause_hours, pause_minutes, pause_seconds))
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get div element with input field for shipment number
Set nodeDivWithInputField = browser.Document.getElementsByClassName("pb-search-form-input-group")(0)
If Not nodeDivWithInputField Is Nothing Then
'If we got the div element ...
'First child element is the input field
Set nodeInputShipmentNumber = nodeDivWithInputField.FirstChild
'Put shipment number to clipboard
textToClipboard.setText "7777777"
textToClipboard.PutInClipboard
'Insert value by trigger paste event of the input field
Call TriggerEvent(browser.Document, nodeInputShipmentNumber, "paste")
'Click button
browser.Document.getElementsByClassName("__c-btn")(0).Click
Else
MsgBox "No input field for shipment number found."
End If
End Sub
And this function 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
As #Stavros Jon alludes to..... there is a browserless way using xhr GET request via API. It returns json and thus you ideally need to use a json parser to handle the response.
I use jsonconverter.bas as the json parser to handle the response. Download raw code from here and add to standard module called JsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime. Remove the top Attribute line from the copied code.
Example request with dummy tracking number (deliberately passed as string):
Option Explicit
Public Sub TntTracking()
Dim json As Object, ws As Worksheet, trackingNumber As String
trackingNumber = "1234567" 'test input value. Currently this is not a valid input but is for demo.
Set ws = ThisWorkbook.Worksheets("Sheet1") 'for later use if writing something specific out
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.tnt.com/api/v3/shipment?con=" & trackingNumber & "&searchType=CON&locale=en_US&channel=OPENTRACK", False
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
'do something with results
Debug.Print json("tracker.output")("notFound").Count > 0
Debug.Print JsonConverter.ConvertToJson(json("tracker.output")("notFound"))
End Sub

Extract data from HTML Element - VBA

I'm new to web scraping and the HTML language.
I'm trying to write a code in VBA to extract data from the following website:
https://companies.govmu.org:4343/MNSOnlineSearch/
I have an Excel sheet with over 5000 company names and their respective "File No" in columns A and B respectively, and I need to input their "Status" (either "Live" or "Defunct") in column C. This will be done after searching for each company by "File No" and then extracting their status to the Excel sheet.
The issue is that I can't seem to get the element containing the data that I need.
I've already written the bit of code which will extract the "File No" from my Excel sheet, paste it on the webpage in the "File No" search box, and run the search. (You can try searching C5113, as an example).
However, on the resulting webpage, I've tried getting the element containing the data that I need, but it does not work.
For example, I tried to MsgBox (MsgBox is my personal way to check whether my variable contains the data I need) the inner HTML of the tag fieldset (fs) with ID "CompanyList" as shown in the code below, but it returns an error.
I've also tried with another variable named div, of data type HTMLDivElement, and then getting the element by ID "companies".
And finally, I've also tried looping through a variable of type IHTMLElementCollection to look for the element that I need, but it still does not show the element that I need (it shows other elements that I don't need).
Option Explicit
Sub ExtractStatusDetails()
Dim ie As InternetExplorer
Dim html As HTMLDocument
Dim resultHtml As HTMLDocument
Dim fs As IHTMLElement
Dim searchBoxes As IHTMLElementCollection
Dim searchButton As Object
Dim homePage As String
homePage = "https://companies.govmu.org:4343/MNSOnlineSearch/"
Set ie = New InternetExplorer
ie.Visible = False
ie.navigate homePage
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set html = ie.document
Set searchBoxes = html.getElementsByClassName("col-md-6 col-lg-4")
searchBoxes(0).innerHTML = Replace(searchBoxes(0).innerHTML, "placeholder", "value")
searchBoxes(0).innerHTML = Replace(searchBoxes(0).innerHTML, "Search company by File No...", "C63")
Set searchButton = searchBoxes(0).getElementsByClassName("btn btn-large btn-primary btn-raised")
searchButton(0).Click
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set resultHtml = ie.document
Set fs = resultHtml.getElementById("CompanyList")
MsgBox fs.innerHTML
ie.Quit
End Sub
The page does an xmlhttp POST request which retrieves data from a backend data store (likely Oracle GlassFish > JDBC API > data repository e.g. MySQL) . It returns all similar matches, possibly including exact.
You can find the POST request in the network traffic of browser dev tools after you enter the fileNo and press the search button.
Below is a function you can call in a loop over your fileNos to retrieve the company status
Option Explicit
Public Sub test()
Dim fileNo As String, xmlhttp As Object
fileNo = "C5113"
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
MsgBox GetCompanyStatus(fileNo, xmlhttp)
End Sub
Public Function GetCompanyStatus(ByVal fileNo As String, ByVal xmlhttp As Object) As String
Dim html As HTMLDocument, body As String, fileNos As Object, i As Long
Set html = New HTMLDocument
body = "tabs=tab-1&searchByName=&searchByFileNo=PLACEHOLDER&submitCompanies=&searchByBusName=&searchByBRN=&searchByIncDateFrom=&searchByIncDateTo=&doAction=search"
With xmlhttp
.Open "POST", "https://companies.govmu.org:4343/MNSOnlineSearch/GetCompanies", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send Replace$(body, "PLACEHOLDER", fileNo)
html.body.innerHTML = .responseText
Set fileNos = html.querySelectorAll("td.tdFileNo")
If fileNos.Length > 0 Then
For i = 0 To fileNos.Length - 1
If fileNos.item(i).innerText = fileNo Then
GetCompanyStatus = html.querySelectorAll("td.tdStatus").item(i).innerText
Exit Function
End If
Next i
End If
GetCompanyStatus = "Not found"
End With
End Function
I would instead consider how you can group your requests. As you can post partial file numbers you could cut down on the number of requests considerably by doing in batches with partial file numbers e.g. search for C5 or C51; the backend then does something like "C5%" to return all matches starting with the specified string, and then loop those results searching for your file numbers of interest that fall within that range.
You could have a dictionary with fileNo as key and status as value and update this as you loop the results returned by a request. I think the number of keys is constrained by Long, so no problem I think for storing all your fileNos at the start, in a dictionary, and updating later during requests. You could even have multiple dictionaries that host ranges of fileNos, like the volumes of the good old Encyclopædia Britannica. This would limit loops to dicts you hope to populate from the same request, for example. Is something to play around with an explore.

How can I retrieve Amazon's keyword/phrase suggestions from the search bar

Below is some code I've found and altered to attempt to capture the keyword/phrase suggestions from Amazon's search bar. I'm very new to the concept of web scraping, so I know the code presented here may be very ineffective and inefficient. I've manually captured some data from the F12 DOM Explorer and Network windows. If the best answer is web scraping, I need that in the form of excel vba. I see in some of the below images that it appears as though some of the content type from the Network window is "application/json" and the Initiator/Type is "XMLHttpRequest", but this is only after it shows a connection and authentication to "https://completion.amazon.com". If that's the route, I have no idea how to complete those requests. Any help would be much appreciated.
So far I've tried invoking the search bar programmatically, via the scripts in the code, but that does nothing that I can see. Simply 'pasting' the keyword into the search bar with a 'space' appended to it does not produce the suggested keywords. However, typing into the search bar does. If I type the keyword in, then choose 'inspect element' of the dropdown suggestions, dynamic HTML is produced to show the HTML content of the suggestions (at which time I can get what I need). I've been unsuccessful in getting to that point.
Private Sub CommandButton1_Click()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim AASearchRank As Workbook
Dim AAws As Worksheet
Dim InputSearch As HTMLInputTextElement
Dim elems As IHTMLElementCollection
Dim TDelement As HTMLTableCell
Dim elems2 As IHTMLElementCollection
Dim TDelement2 As HTMLDivElement
'Dim TDelement2 As HTMLInputTextElement
Dim InputSearchButton As HTMLInputButtonElement
Dim IE As InternetExplorer
Dim x As Integer
Dim i As Long
MyURL = "https://www.amazon.com/"
Set IE = New InternetExplorer
With IE
.Silent = True
.Navigate MyURL
.Visible = True
Do
DoEvents
Loop Until .ReadyState = READYSTATE_COMPLETE
End With
Set HTMLDoc = IE.Document
Set AASearchRank = Application.ThisWorkbook
Set AAws = AASearchRank.Worksheets("Sheet2")
Set InputSearchButton = HTMLDoc.getElementById("nav-search-submit-text")
Set InputSearchOrder = HTMLDoc.getElementById("twotabsearchtextbox")
If Not InputSearchOrder Is Nothing Then
InputSearchButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
End If
x = 2
If AAws.Range("D" & x).Value = "" Then
Do Until AAws.Range("B" & x) = ""
Set InputSearch = HTMLDoc.getElementById("twotabsearchtextbox")
InputSearch.Focus
'When a keyword is typed in the search bar with a 'space' after, it invokes the suggestions I'm looking for.
InputSearch.Value = "Travel "
'InputSearch.Value = AAws.Range("C" & x) & " "
Set InputSearchButton = HTMLDoc.getElementsByClassName("nav-input")(0)
InputSearch.Focus
'Here I was trying to invoke some script to see if it had any effect on the search bar drop down
HTMLDoc.parentWindow.execScript "window.navmet.push({key:'UpNav',end:+new Date(),begin:window.navmet.tmp});"
HTMLDoc.parentWindow.execScript "window.navmet.push({key:'Search',end:+new Date(),begin:window.navmet.tmp});"
HTMLDoc.parentWindow.execScript "window.navmet.push({key:'NavBar',end:+new Date(),begin:window.navmet.main});"
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
'Application.Wait (Now + TimeValue("0:00:05"))
Set elems2 = HTMLDoc.getElementsByClassName("nav-issFlyout nav-flyout")
i = 0
For Each TDelement2 In elems2
'Debug statements strictly for learning what each option/query returns
Debug.Print TDelement2.innerText
Debug.Print TDelement2.className
Debug.Print TDelement2.dataFld
Debug.Print TDelement2.innerHTML
Debug.Print TDelement2.outerText
Debug.Print TDelement2.outerHTML
Debug.Print TDelement2.parentElement.className
Debug.Print TDelement2.tagName
Debug.Print TDelement2.ID
Next
'Once the searchbar is populated, and the drop down list provides suggestions,
'the below code will give me what I want. If there's an easier solution,
'I'm all for it
Set elems = HTMLDoc.getElementsByClassName("s-suggestion")
i = 0
For Each TDelement In elems
If Left(TDelement.ID, 6) = "issDiv" Then
Debug.Print TDelement.innerText
Debug.Print TDelement.ID
End If
Next
x = x + 1
Loop
End If
End Sub
An ideal solution would be to obtain these suggested keywords through either invoking the search bar dynamic HTML or via Amazon's completion site, but it appears as though that might not be open to the general public. Thank you for any help, and apologies up front for any posting deficiencies.
There is an API call you can find in the network tab. It returns a json string you can parse with as jsonparser to get the suggestions. I use jsonconverter.bas which, once downloaded I add to the project and then go VBE > Tools > References > Add a reference to Microsoft Scripting Runtime.
The url itself is a queryString i.e. it is constructed of different parameters. For example, there is a limit parameter, whose value is 11, which specifies the number of suggestions to return. You may be able to alter and/or remove some of these. Below, I concatenate the SEARCH_TERM constant into the query string to represent your search value (that which would be typed into the search box).
I don't know whether any of the params are time-based (i.e. expire over time - I have made a number of requests without problem since you posted your question). It may be that necessary time based values can be pulled via a prior GET request to Amazon search page.
params = (
('session-id', '141-0042012-2829544'),
('customer-id', ''),
('request-id', '7E7YCB7AZZM1HQEZF2G1'),
('page-type', 'Search'),
('lop', 'en_US'),
('site-variant', 'desktop'),
('client-info', 'amazon-search-ui'),
('mid', 'ATVPDKIKX0DER'),
('alias', 'aps'),
('b2b', '0'),
('fresh', '0'),
('ks', '76'),
('prefix', 'TRAVEL'),
('event', 'onKeyPress'),
('limit', '11'),
('fb', '1'),
('suggestion-type', ['KEYWORD', 'WIDGET']),
('_', '1556820864750')
)
VBA:
Option Explicit
Public Sub GetTable()
Dim json As Object, suggestion As Object '< VBE > Tools > References > Microsoft Scripting Runtime
Const SEARCH_TERM As String = "TRAVEL"
Const SEARCH_TERM2 As String = "BOOKS"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://completion.amazon.com/api/2017/suggestions?session-id=141-0042012-2829544" & _
"&customer-id=&request-id=7E7YCB7AZZM1HQEZF2G1&page-type=Search&lop=en_US&site-variant=" & _
"desktop&client-info=amazon-search-ui&mid=ATVPDKIKX0DER&alias=aps&b2b=0&fresh=0&ks=76&" & _
"prefix=" & SEARCH_TERM & "&event=onKeyPress&limit=11&fb=1&suggestion-type=KEYWORD&suggestion-type=" & _
"WIDGET&_=1556820864750", False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
Set json = JsonConverter.ParseJson(.responseText)("suggestions")
End With
For Each suggestion In json
Debug.Print suggestion("value")
Next
End Sub

How to get META keywords content with VBA from source code in an EXCEL file

I have to download the source code of a several hundred websites to an Excel file (for example to cells(1, 1) in Worksheets 1) and then extract the content of of the META tag keywords in let's say cells(1, 2).
For downloading I use the following code in VBA:
Dim htm As Object
Set htm = CreateObject("HTMLfile")
URL = "https://www.insolvenzbekanntmachungen.de/cgi-bin/bl_aufruf.pl?PHPSESSID=8ecbeb942c887974468b9010531fc7ab&datei=gerichte/nw/agkoeln/16/0071_IN00181_16/2016_06_10__11_53_26_Anordnung_Sicherungsmassnahmen.htm"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
htm.body.innerHTML = .responseText
Cells(1, 1) = .responseText
End With
I've found the following code on this website but, unfortunately, I'm unable to adapt it to solve my problem:
Sub GetData()
Dim ie As New InternetExplorer
Dim str As String
Dim wk As Worksheet
Dim webpage As New HTMLDocument
Dim item As HTMLHtmlElement
Set wk = Worksheets(1)
str = "https://www.insolvenzbekanntmachungen.de/cgi-bin/bl_aufruf.pl?PHPSESSID=8ecbeb942c887974468b9010531fc7ab&datei=gerichte/nw/agkoeln/16/0071_IN00181_16/2016_06_10__11_53_26_Anordnung_Sicherungsmassnahmen.htm"
ie.Visible = True
ie.navigate str
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
'Find the proper meta element --------------
Const META_TAG As String = "META"
Const META_NAME As String = "keywords"
Dim Doc As HTMLDocument
Dim metaElements As Object
Dim element As Object
Dim kwd As String
Set Doc = ie.Document
Set metaElements = Doc.all.tags(META_TAG)
For Each element In metaElements
If element.Name = META_NAME Then
kwd = element.Content
End If
Next
MsgBox kwd
End Sub
I think I have to modify this line, but don't know how:
Set Doc = ie.Document
Can you please help me out?
Embed a WebrowserControl into a Excel Spreadsheet or userform
How to add a Webrowser to Excel
Set up references to the HTML Object Library
How to add VBA References – Internet Controls, HTML Object Library
Grab Greg Truby's code from this post Webbroswer Control
You'll have access the Document Object Model (DOM). This will expose most of the HTMLElements properties and event's
Option Explicit
Private WithEvents htmDocument As HTMLDocument
Private WithEvents MyButton As HTMLButtonElement
Private Function MyButton_onclick() As Boolean
MsgBox "Sombody Click MyButton on WebBrowser1"
End Function
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Dim aTags As Hyperlinks
Do Until .ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
Set MyButton = htmDocument.getElementById("MyButtonID")
Set htmDocument = WebBrowser1.Document
Set aTags = htmDocument.getElementsByTagName("a")
End Sub
Google Web Api, HTA, (MDN){https://developer.mozilla.org/en-US/docs/Web/API} and if you get stuck try to refactor Javascript code to vbscript. It's

Excel VBA automation of html form generated by php

I am a non-coder/programmer trying to create an excel spreadsheet that utilizes some VBA automation to import some web-data based on certain cell values. I have managed to scrape together part of the process using Youtube and some other sites like this. However, I have hit a road block that I am hoping someone could help me with.
Here is the setup:
I am trying to import some Co2 data based on 2 parameters (pressure and temperature) that will reside in 2 separate cells in my excel sheet.
In my VBA code, I have managed to navigate to the first site (http://www.peacesoftware.de/einigewerte/co2_e.html), and then find the table elements, fill them in, and submit the form.
My problem is when IE navigates to the next page where the results are. I do not know how to import table elements from this new page. I assume I need to tell VBA to look at the new page, but it has a generic URL (http://www.peacesoftware.de/einigewerte/calc_co2.php5), so I am confused on what to reference.
I hope this is all the info needed to get a clear picture of my problem. Here is my current VBA code. The end part after "submit" is a wild guess on my part. Once VBA is looking at the right table/page, I will then import the enthalpy and entropy values to my excel spreadsheet.
Thanks in advance for your help!
' updates enthalpy, entropy data from peacesoftware site
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = Range("tempA").Row And Target.Column = Range("tempA").Column Then
Dim IE As Object
Dim pressA As String
Dim tempA As String
Dim denseA As String
Dim enthA As String
Dim entroA As Style
tempA = Range("tempA")
pressA = Range("pressA")
Set IE = CreateObject("InternetExplorer.Application")
' setup internet explorer
IE.Visible = True
IE.navigate "http://www.peacesoftware.de/einigewerte/co2_e.html"
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
' find pressure and temp entry form
IE.document.getElementsByName("druck")(0).Value = pressA
IE.document.getElementsByName("temperatur")(0).Value = tempA
IE.document.forms(0).submit
'Do
'DoEvents
'Loop Until IE.readyState = READYSTATE_COMPLETE
'update new energy data
'IE.navigate table_url ???
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
***Update
I think I found a solution, so I can at least get it functional. (thanks to this post: excel vba form submit and parse data from result )
I needed to wait after submit and then search for the "td" element I needed. Since the actual value I needed was the next element after the element label, I used TDelement.nextElementSibling.innerText to grab it.
IE.document.forms(0).submit
' wait for new page to load
Do While IE.Busy: DoEvents: Loop
Set doc = IE.document
Dim sdd As String
Set TDelements = doc.getElementsByTagName("td")
r = 0
For Each TDelement In TDelements
If TDelement.innerText = "Density : " Then
Range("denseA") = TDelement.nextElementSibling.innerText
r = r + 1
End If
Next
Thanks again for the help.
The problem is that the form is sent by POST and not by GET.
That means that you cannot see/manipulate/send the parameters in the URL.
BUT you can use VBA to send a POST-Request directly to the result page.
The following code gets you the values you mentioned in the commenct-section of this response.
You have to change the postData-variable if you want another temperature or 'druck':
This Example-Code just gives you the result for the values 20 and 20.
Dim Density As String
Dim Entropy As String
Dim Enthalpy As String
Dim SoA As String
Dim Result As String
Dim myURL As String, postData As String
Dim winHttpReq As Object
Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
myURL = "http://www.peacesoftware.de/einigewerte/calc_co2.php5"
postData = "lang=english&calc=standard&druck=20&druckunit=1&temperatur=20&tempunit=1"
winHttpReq.Open "POST", myURL, False
winHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
winHttpReq.Send (postData)
Result = winHttpReq.responseText
Density = getValue("Density", Result, False)
Entropy = getValue("Entropy", Result, False)
Enthalpy = getValue("Enthalpy", Result, False)
SoA = getValue("state of aggregation", Result, True)
Additionally I created a helper-function which must also be implemented:
Public Function getValue(Property As String, Result As String, isBold As Boolean) As String
Dim posProp As Long
Dim posTD As Long
Dim posEndTD As Long
Dim startPosVal As Long
Dim endPosVal As Long
Dim valLength As Long
Dim Value As String
'find the position of the value on the page
posProp = InStr(1, Result, Property)
If posProp > 0 Then
posTD = InStr(posProp, Result, "<td>")
If isBold = True Then
posEndTD = InStr(posTD, Result, "</b></td>")
startPosVal = posTD + 7
Else
posEndTD = InStr(posTD, Result, "</td>")
startPosVal = posTD + 4
End If
endPosVal = posEndTD
valLength = endPosVal - startPosVal
Value = Mid(Result, startPosVal, valLength)
getValue = Value
End If
End Function
Hope this helps!
If you need any help just leave me a comment.
EDIT:
Ah i just read that you found a solution.
But I think this code is a bit cleaner and faster because it just send ONE http-request directly to the result-page.