I am trying to convert a value to NOK(USD to NOK for instance), but I have trouble getting the whole html page to load.
I am using the code found here , but the the html i get in return display this
"<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html lang="en-US">
<head>
<title>USDNOK=X: Summary for USD/NOK- Yahoo! Finance</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"><met
So it is basically stripping the webpage, or rather is not waiting untill its done loading. The code in the link for getting webpage is this:
Function ExecuteWebRequest(ByVal url As String) As String
Dim oXHTTP As Object
If InStr(1, url, "?", 1) <> 0 Then
url = url & "&cb=" & Timer() * 100
Else
url = url & "?cb=" & Timer() * 100
End If
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "GET", url, False
oXHTTP.send
ExecuteWebRequest = oXHTTP.responseText
Set oXHTTP = Nothing
End Function
Maybe there is a better way of getting todays exchange rate in vba.
This code works superb, it uses Yahoo as well, but is up to date with html parsing.
Related
I'm trying to catch a Response to a POST Request using XMLHTTP using the code below
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim htmlEle1 As MSHTML.IHTMLElement
Dim htmlEle2 As MSHTML.IHTMLElement
Dim URL As String
Dim elemValue As String
URL = "https://www.informadb.pt/pt/pesquisa/?search=500004064"
XMLPage.Open "GET", URL, False
XMLPage.send
HTMLDoc.body.innerHTML = XMLPage.responseText
For Each htmlEle1 In HTMLDoc.getElementsByTagName("div")
Debug.Print htmlEle1.className
If htmlEle1.className = "styles__SCFileModuleFooter-e6rbca-1 kUUNkj" Then
elemValue = Trim(htmlEle1.innerText)
If InStr(UCase$(elemValue), "CONSTITU") > 0 Then
'Found Value
Exit For
End If
End If
Next htmlEle1
The problem is that I can't find the ClassName "styles__SCFileModuleFooter-e6rbca-1 kUUNkj", because I notice that when I manually insert the value (500004064) in the search box of the URL : https://www.informadb.pt/pt/pesquisa/, the Web Page generates addicinal traffic and turns up at an end point URL : https://www.informadb.pt/pt/pesquisa/empresa/?Duns=453060832, where that className can be found in the Request ResponseText.
My goal is to use the First URL to retrieve the Duns number '453060832', to be able to access the information in the ResponseText of the EndPoint URL. And to catch Duns Number, I need to find a way to get the Endpoint URL, or try to get The POST request response below, and get that value using JSON parser:
{'TotalResults': 1,
'NumberOfPages': 1,
'Results': [{'Duns': '453060832',
'Vat': '500004064',
'Name': 'A PANIFICADORA CENTRAL EBORENSE, S.A.',
'Address': 'BAIRRO DE NOSSA SENHORA DO CARMO,',
'Locality': 'ÉVORA',
'OfficeType': 'HeadOffice',
'FoundIn': None,
'Score': 231.72766,
'PageUrl': '/pt/pesquisa/empresa/?Duns=453060832'}]}
I'm not being able to capture what is really happening using the XMLHTTP Browser request, that seems to be the below steps:
navigate to https://www.informadb.pt/pt/pesquisa/?search=500004064
Webpage generates additional traffic
Amongst that additional traffic is an API POST XHR request which
returns search results as JSON. That request goes to
https://www.informadb.pt/Umbraco/Api/Search/Companies and includes
the 500004064 identifier amongst the arguments within the post body
Based on the API results the browser ends up at the following URI
https://www.informadb.pt/pt/pesquisa/empresa/?Duns=453060832
Can someone help me please, I have to do it using VBA.
Thanks in advance.
A small example how to POST data to your website using VBA, and how to use bare-bones string processing to extract data from the result, as outlined in my comments above.
Function GetVatId(dunsNumber As String) As String
With New MSXML2.XMLHTTP60
.open "POST", "https://www.informadb.pt/Umbraco/Api/Search/Companies", False
.setRequestHeader "Content-Type", "application/json"
.send "{""Page"":0,""PageSize"":5,""SearchTerm"":""" & dunsNumber & """,""Filters"":[{""Key"":""districtFilter"",""Name"":""Distrito"",""Values"":[]},{""Key"":""legalFormFilter"",""Name"":""Forma Jurídica"",""Values"":[]}],""Culture"":""pt""}"
If .status = 200 Then
MsgBox "Response: " & .responseText, vbInformation
GetVatId = Mid(.responseText, InStr(.responseText, """Vat"":""") + 7, 9)
Else
MsgBox "Repsonse status " & .status, vbExclamation
End If
End With
End Function
Usage:
Dim vatId As String
vatId = GetVatId("453060832") ' => "500004064"
For a more robust solution, you should use a JSON parser and -serializer, something like https://github.com/VBA-tools/VBA-JSON.
i am trying to get data using MSXML2.XMLHTTP
but it didn't work
any ideas?
Sub getdata
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As String
Dim sht As Worksheet
Application.DisplayAlerts = False
Set sht = ActiveSheet
On Error Resume Next
website = "https://shopee.co.id/AFI-EC-Tshirt-Yumia-(LD-90-P-57)-i.10221730.5568491283"
Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "GET", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send
response = StrConv(request.responseBody, vbUnicode)
html.DocumentElement.innerHTML = response
price = html.querySelector("div.AJyN7v")(0).innerText
Debug.Print price
Application.StatusBar = ""
On Error GoTo 0
Application.DisplayAlerts = True``
End Sub
I have done many ways but still not working ,
hope someone can help me
Pretty much everything on that page requires javascript to load. Javascript doesn't run with xmlhttp request to landing page so price never gets retrieved..
The price is being retrieved dynamically from an additional API call returning json.
If you examine the url you will have the following:
https://shopee.co.id/AFI-EC-Tshirt-Yumia-(LD-90-P-57)-i.10221730.5568491283
The last set of consecutive numbers is the product id i.e. 5568491283.
If you open the network tab of dev tools F12, and press F5 to refresh the web traffic that updates the page, then check on the xhr only traffic, then input your product id into the search box, the first result retrieved is the xhr which is returning the price:
https://shopee.co.id/api/v2/item/get?itemid=5568491283&shopid=10221730
The response is json so you will need a json parser to extract the result (or use regex on string - less preferable)
In the headers sub-tab you can view info about the xhr request made.
Check the terms and conditions to see if scraping allowed and also whether there is an public API for retrieving this data.
I have two files; "1.hta" and "2.hta".
"1.hta" contains a simple link to file "2.hta"
2.hta
"2.hta" contains a script to determine its own filename
FullName = replace(oApp.commandLine,chr(34),"") 'oApp = HT Application ID
arrFN=split(FullName,"\")
FileName = arrFN(ubound(arrFN))
SourceDir=replace(FullName,FileName,"")
"2.hta" works perfectly when started "stand-alone" --> FileName = 2.hta
However, starting "2.hta" via link from "1.hta" I get --> FileName = 1.hta
I need a way to determine the correct filename, or does hta always retrieve the filename of the first/starting instance?
You can try like this :
<html>
<head>
<title>HTA Launch another HTA</title>
<HTA:APPLICATION
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
>
</head>
<SCRIPT Language="vbscript">
Sub Execute(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run chr(34) & File & chr(34)
End sub
</SCRIPT>
<body>
<h1>This is test hta 1 ONE</h1>
Start the HTA2
</body>
</html>
I've come across such a webpage which seems to me a bit misleading
to scrape. When I go the address "https://jobboerse2.arbeitsagentur.de/jobsuche/?s=1" it takes me to a page with "suchen" option. After clicking "suchen" it opens a new layout within this tab and takes me to a page with lots of names. So, the site address is same again "https://jobboerse2.arbeitsagentur.de/jobsuche/?s=1".
I would like to scrape the names of that page, as in "Mitarbeiter für die Leerguttrennung (m/w)". Any help would be highly appreciated.
What I wrote so far:
Sub WebData()
Dim http As New MSXML2.xmlhttp60
Dim html As New htmldocument, source As Object, item As Object
With http
.Open "GET", "https://jobboerse2.arbeitsagentur.de/jobsuche/?s=1", False
.send
html.body.innerHTML = .responseText
End With
Set source = html.getElementsByClassName("ng-binding ng-scope")
For Each item In source
x = x + 1
Cells(x, 1) = item.innerText
Next item
Set html = Nothing: Set source = Nothing
End Sub
The links are incremented like these as per xhr in developer tool but can't figure out what is the number of the last link.
"https://jobboerse2.arbeitsagentur.de/jobsuche/pc/v1/jobs"
"https://jobboerse2.arbeitsagentur.d...00&FCT.ANGEBOTSART=ARBEIT&FCT.BEHINDERUNG=AUS"
"https://jobboerse2.arbeitsagentur.d...EBOTSART=ARBEIT&FCT.BEHINDERUNG=AUS&offset=12"
"https://jobboerse2.arbeitsagentur.d...EBOTSART=ARBEIT&FCT.BEHINDERUNG=AUS&offset=24"
"https://jobboerse2.arbeitsagentur.d...EBOTSART=ARBEIT&FCT.BEHINDERUNG=AUS&offset=36"
I'm trying to forward an email that I received and append an additional message on top of it. The following code I wrote kinda does this, but I lose all the formatting of the original message. Is there any way to maintain the format of the original message and yet able to append additional test to the email?
MY CODE:
Sub xForward()
myMessage = "You recently requested access to the table. We are requiring all requests to complete a mandatory training session." & vbCr & vbCr & "Thank you, " & vbCr & "Ricky"
Dim itmOld As MailItem, itmNew As MailItem
Set itmOld = ActiveInspector.CurrentItem
Set itmNew = itmOld.Forward
itmNew.Body = myMessage & vbCr & vbCr & itmOld.Body
itmNew.Subject = "Access Request"
itmNew.Display
Set itmOld = Nothing
Set itmNew = Nothing
End Sub
If I don't update the body of itmNew, then I maintain the format of the original message. The moment I update itmNew.Body, then itmOld.Body is written in simple text and I lose all the formatting.
I think JP's comment points you in the right direction but I assume your questions results from limited knowledge of HTML. This is not a complete tutorial on HTML but I hope it gets your started.
If you use Debug.Print to output .HTMLBody to the immediate window you will see something like:
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html
xmlns="http://www.w3.org/1999/xhtml"> <head>
Lots of stuff here
</head> <body>
Lots of stuff here
</body> </html>
You will only get "<!DOCTYPE html ... " if the package that created the message supports the XML version of HTML. The minimum you should see is:
<html><head> Lots of stuff here </head><body> Lots of
stuff here </body></html>
If you place your extra message in front or at the end of this then you are breaking the rules of HTML. What happens will depend on how forgiving the receiver's email package is. To conform to the rules of HTML, you must place your extra message somewhere between "<body>" and "</body>".
If you look through a few messages, you will see how much they can vary. Some will be black text on white, some white text on black with every variation in between. Your message must be readable no matter what the message's authors have done. My suggestion is you create a one cell table at the top and you set the font and background colours. Try the following and then adapt it to your requirements:
Dim AddedMsg As String
Dim Pos As Long
' Create message to be inserted
' =============================
' Start a table with white background and blue text
AddedMsg = "<table border=0 width=""100%"" style=""Color: #0000FF"" bgColor=#FFFFFF>"
' Add row with single cell
AddedMsg = AddedMsg & "<tr><td><p>Cool stuff you must see!!</p></td></tr>"
' End table
AddedMsg = AddedMsg & "</table>"
' Code to add message once you have checked there is an HTML body
'================================================================
Pos = InStr(1, LCase(.HTMLBody), "<body")
If Pos = 0 Then
' This should be impossible.
Call MsgBox("<Body> element not found in HTML body", vbCritical)
' Code to handle impossible situation
End If
Pos = InStr(Pos, .HTMLBody, ">")
If Pos = 0 Then
' This should be impossible.
Call MsgBox("Terminating > for <Body> element not found in HTML body", vbCritical)
' Code to handle impossible situation
End If
'Insert your message
.HTMLBody = Mid(.HTMLBody, 1, Pos) & AddedMsg & Mid(.HTMLBody, Pos + 1)