Extract data from HTML Element - VBA - html

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.

Related

Importing data from a hyperlink on a webpage in excel using macros

I want to import some data from a website https://www.amfiindia.com/nav-history-download. On this page, there is a link "Download Complete NAV Report in Text Format" which will give me the required data. But this link is not static so I cannot use this directly in VBA to download my data. So how to download data from a hyperlink on a webpage using excel?
My approach is first getting the hyperlink in a variable then use that variable to get the data?
First, get the hyperlink using getElementsByTagName function as shown below.
Then use that as URL to get the data.
But I am getting type mismatch error while equating website which is a string with my hyperlink.
I don't know the type of href. Tried seeing in watch window showing Variant, tried that still error.
Kindly help me with this.
Sub webscraping()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant
Dim cellAddress As String
Dim rowNumber As Long
Dim ie As InternetExplorer
Dim ht As HTMLDocument
Dim hr As MSHTML.IHTMLElement
'Dim Hra As MSHTML.IHTMLElement
Set ie = New InternetExplorer
ie.Visible = True
ie.Navigate ("https://www.amfiindia.com/nav-history-download")
Do Until ie.ReadyState >= 4
DoEvents
Loop
Set ht = ie.Document
'MsgBox ht.getElementById("navhistorydownload")
Set hr = ht.getElementsByTagName("a")(18).href
' Website to go to.
website = StrConv(hr, vbUnicode)
' Create the object that will make the webpage request.
Set request = CreateObject("MSXML2.XMLHTTP")
' Where to go and how to go there - probably don't need to change this.
request.Open "GET", website, False
' Get fresh data.
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
' Send the request for the webpage.
request.send
' Get the webpage response data into a variable.
response = StrConv(request.responseBody, vbUnicode)
' Put the webpage into an html object to make data references easier.
html.body.innerHTML = response
' Get the price from the specified element on the page.
'price = html.getElementstagName("a").Item(0).innerText
cellAddress = Range("A" & Rows.Count).End(xlUp).Address
rowNumber = Range(cellAddress).Row
ThisWorkbook.Sheets(1).Cells(rowNumber + 1, 1) = response
' MsgBox rowNumber
' MsgBox cellAddress
' Output the price into a message box.
'MsgBox price
End Sub
If you don't know the type then you can use
?typename(ht.getElementsByTagName("a")(18).href)
in the immediate window.
It should be a string and declared as such.
Rather than indexing into an anchor collection I would grab by css selector
ht.querySelector(".nav-hist-dwnld a").href
This specifies the parent node with class name nav-hist-dwnld and then asks for the first child a tag.
This, website = StrConv(hr, vbUnicode) is not required. Use the extracted href direct.

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

filling a html auto search box and obtaining the results

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()"

Can MSXML2.XMLHTTP retrieve ALL of the HTML data for a given webpage?

With dynamic web pages that display a table of retrieved data, I’ve found that both MSXML2.XMLHTTP and the Internet Explorer object usually can’t access this data. A good example is https://www.tiff.net/tiff/films.html. Both techniques won’t retrieve any of the movie data – just the surrounding web page. The code I’ve tried is as follows:
Function getHTTP(ByVal sReq As String) As Variant
On Error GoTo onErr
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", sReq, False
.send
getHTTP = StrConv(.responseBody, 64)
End With
Exit Function
onErr: MsgBox "Error " & Err & ": " & Err.Description, 49, "Error opening site"
End Function
Function GetHTML(ByVal strURL As String) As Variant
Dim oIE As InternetExplorer
Dim hElm As IHTMLElement
Set oIE = New InternetExplorer
oIE.Navigate strURL
Do While (oIE.Busy Or oIE.ReadyState <> READYSTATE_COMPLETE)
DoEvents
Loop
Set hElm = oIE.Document.all.tags("html").Item(0)
GetHTML = hElm.outerHTML
Set oIE = Nothing
Set hElm = Nothing
End Function
But there is a way to manually retrieve the movie data – just follow these steps with Microsoft Edge or Internet Explorer:
Right-click on one of the movies
Choose “inspect element." The DevTools console opens.
At the bottom-left of the screen, click on the “html” tab.
Right-click the tab. Choose “copy.”
Open notepad and paste what you’ve copied.
You now have the movie data and can save it to a file for parsing. My question: Is there any way to get this data programmatically?
Why Json? Because the page is loaded using json data
To View: Use Google Chrome --> Press F12 --> Load URL --> Goto Network tab
Code:
Sub getHTTP()
Dim Url As String, data As String
Dim xml As Object, JSON As Object, colObj, item
Url = "https://www.tiff.net/data/films-events-2018.json?q=1513263947586"
Set xml = CreateObject("MSXML2.ServerXMLHTTP")
With xml
.Open "GET", Url, False
.send
data = .responseText
End With
Set JSON = JsonConverter.ParseJson(data)
Set colObj = JSON("items")
For Each item In colObj
Debug.Print item("title")
Debug.Print item("description")
For Each c1 In item("cast")
Debug.Print c1
Next
For Each c2 In item("countries")
Debug.Print c2
Next
Next
End Sub
Output
Installation of JsonConverter
Download the latest release
Import JsonConverter.bas into your project (Open VBA Editor, Alt + F11; File > Import File)
Add Dictionary reference/class
For Windows-only, include a reference to "Microsoft Scripting Runtime"
For Windows and Mac, include VBA-Dictionary
Tree View of Data
Here are the film titles using IE (you can use same process to get directors)
Option Explicit
Public Sub GetFilms()
Dim IE As New InternetExplorer, html As HTMLDocument, films As Object, i As Long
With IE
.Visible = True
.navigate "https://www.tiff.net/tiff/films.html"
While .Busy Or .readyState < 4: DoEvents: Wend
Set films = .document.querySelectorAll("[target=_self]")
For i = 0 To films.Length - 1
Debug.Print films.item(i).innerText
Next
.Quit '<== Remember to quit application
End With
End Sub
XHR is too fast for this, with the URL provided, but IE is just fine.
If you inspect the HTML you can see each film has the following commonality:
There is an attribute within the a tag called target whose value is _self.
You can use an attribute CSS selector to gather all of these matching elements using the querySelectorAll method of document.
CSS selector (sample):
I would be interested in if this can be solved for getting the film descriptions by parsing the HTML. I had thought the presence of the comments was obscuring the film descriptions. A regex which selects the text within these in theory "<!-- react-text: \d+ -->([^...].+?(?=<))" seems to fail when applied to the .innerHTML as did attempts to swop out the comment start and finish with regex.

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.