I have an function in Excel:
Function getState(Defects As Object) As String
Dim str As String
Dim res As String
Dim was As Boolean
Dim sURL As String
Dim oRequest As Object
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
was = False
For Each defect In Defects
If was = False Then
str = "(FormattedID = """ & defect & """)"
res = str
was = True
Else
res = res & " OR " & str
End If
Next defect
sURL = "https://rally1.rallydev.com/slm/webservice/v2.0/defect?query=(" & res & ")&fetch=FormattedID,State"
oRequest.Open "GET", sURL, True
oRequest.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
oRequest.Send
oRequest.WaitForResponse
' Set Defects = oRequest.ResponseText
Debug.Print (oRequest.ResponseText)
End Function
Unfortunately, i get rubbish instead of json in response like:
? i?ANA0E?=A(utU
¤RoP°irC°%'.o$%·CI{OOYO????uApeaBRM?Zb?u?OWo?"{oSCy5?(}e??e?qBA"qnu~E·Uu?|?aRbE?a>anµ?c?9P=?A[Oul?0i O {PZS?Af~???^??k??R˜?|©?#iEoPN O|?¦'y ?vO^Ol? ]?g?#?AjAa?\aC¤y %©e»]"IHog??#:?· (??"¶E9yog?Az?7bw?/#?eWp^u?ZU?u??3?q?A)c y7µe?E
Could you please take a look at it and provide an solution how it can be fixed?
Thank you in advance!
Larry's answer is correct.
As an aside, if you need to pull data from Rally into Excel, your best bet is the Rally Add-in for Excel:
https://help.rallydev.com/rally-add-excel
Since you mentioned VBA, you may be working to build some automation in Excel, which the Excel add-in doesn't support. There is an alpha-level Rally Rest Toolkit for VBA. It handles the authentication and REST serialization/de-serialization for you, so it could ease some of your coding effort.
It is unofficial and not supported by Rally, but could be worth trying. Since it is unsupported though, Rally can't help you out if you run into issues. You'd have to refactor your own code against the VBA toolkit to pull the data you want:
https://github.com/markwilliams970/RallyRestToolkitForVBA
The response is compressed. Either try setting a request header for Accept-Encoding: identity or decompress the response.
Related
Question
Is it possible to call Microsoft Graph API using VBA code?
If yes, how to handle O365 authorization? I have seen plenty of topics saying to create an application in Microsoft Azure to get a token but I am surprised I must do that for a simple local use.
What I tried
After discovering Microsoft Graph, I tried this API in Graph Explorer
https://graph.microsoft.com/v1.0/planner/tasks
I was able to create a task in planner!
Consequently, in my mind, it was possible to call this API from VBA code executed directly in Outlook.
I created this macro in Outlook:
Sub TaskPlannerCreation()
Dim PlannerService As New MSXML2.XMLHTTP60
Dim sData As Variant
sData = " { "" ""planId"": ""K9Zv2QHm1U-GSAhd-PTGZfdFeOn"",""bucketId"": ""b6NVNiEIQkGZeBBzn7kWqJvAGvvs"",""title"": ""Outlook task"" } "
With PlannerService
.Open "POST", "https://graph.microsoft.com/v1.0/planner/tasks", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "User-Agent", "xx"
.Send (sData)
I have an Authorization error with
error code 401
UPDATE on 12-03-2020 :
Solution found to get a Graph Api token analysing URL when calling Graph Explorer (works perfectly for me) :
Function GetToken()
Dim xml As New MSXML2.XMLHTTP60
Dim doc As MSHTML.HTMLDocument
Dim urltoken As String
'copy paste the URL you see when calling Microsoft Graph Explorer and add prompt + domain_hint parameters
urltoken = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize?response_mode=form_post&nonce=graph_explorer&mkt=fr-FR&client_id={clientid}&response_type=token&scope=openid profile User.ReadWrite User.ReadBasic.All Sites.ReadWrite.All Contacts.ReadWrite People.Read Notes.ReadWrite.All Tasks.ReadWrite Mail.ReadWrite Files.ReadWrite.All Calendars.ReadWrite&prompt=none&domain_hint=organizations"
xml.Open "GET", urltoken, False
xml.Send
If xml.readyState = 4 And xml.Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.Body.innerHTML = xml.responseText
GetToken = doc.getElementsByName("access_token")(0).Value
sSuccess = True
Else
MsgBox "Error" & vbNewLine & "Ready state: " & xml.readyState & _
vbNewLine & "HTTP request status: " & xml.Status
sSuccess = False
End If
Set xml = Nothing
End Function
So using VBA for calling Graph API is possible :)
So the code you show is only partially correct. Here is what I found to actually work. (This is with what you provided as I actually found a Json parser to work with the data better than the innerHTML methods, I also had to use a different version of MSXML since the one you reference wasnt working for me.)
Function GetToken()
Dim xml As New MSXML2.XMLHTTP60
Dim doc As MSHTML.HTMLDocument
Dim urltoken As String
'copy paste the URL you see when calling Microsoft Graph Explorer and add prompt + domain_hint parameters
urltoken = "https://login.microsoftonline.com/{tenent id}/oauth2/v2.0/token"
xml.Open "POST", urltoken, False
xml.Send("client_id={clientid}&scope=https://graph.microsoft.com/.default&grant_type=client_credentials&client_secret=(cleint secret}")
If xml.readyState = 4 And xml.Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.Body.innerHTML = xml.responseText
GetToken = doc.getElementsByName("access_token")(0).Value
sSuccess = True
Else
MsgBox "Error" & vbNewLine & "Ready state: " & xml.readyState & _
vbNewLine & "HTTP request status: " & xml.Status
sSuccess = False
End If
Set xml = Nothing
End Function
Here is a piece of code that should connect to a web page with contents as follows: link1, description1, otherdata1, link2, description2, otherdata2, ..., linkN, descriptionN, otherdataN where N is 30 000 +.
From these links, the program finds one link of interest using regex, goes to that link, and downloads a file from there.
My problem is: at htmlWebInterfaceXML.send the program frequently, but not always, runs out of memory ('out-of-memory' error). It is difficult for me to test different solutions because normally the program runs smoothly, and it is difficult to notice changes if any.
Additional info:
It runs smoothly on some PCs and does not work for others
It usually runs until afternoon and throws an error then
Other infos that may be helpful:
the code shown is a private method of class and the class itself is a small part of the source code
other subs called which I do not explain are not relevant and run smoothly, the probelm always appears at htmlWebInterfaceXML.send.
One guess of mine is that I have declared local variable inside of a function that holds a very large object and can cause a stack overflow but it seems unlikely as VBA should handle those things on its own. Maybe you see a problem that I don't? Thank you.
Private Sub FileUpload()
' THE FUNCTION CANNOT BE CONNECTING FOR EACH CONTRACT ID! WILL TAKE TOO MUCH TIME - NEED TO ALTER
Dim member As Variant
Dim byteCounter As Byte
Dim byteMaxID As Byte
Dim strPathToXMLFile As String
Dim strURLToXMLFile
Dim strXMLFileStorageName As String
Dim domdocXMLText As New MSXML2.DOMDocument
Dim clctStrFoundMatches As New Collection
Dim clctInternalIDs As New Collection
Dim vrntContractID As Variant
Dim htmlHTMLMainPageXMLInterface As New MSHTML.HTMLDocument
Dim htmlTagElement As Variant
Dim htmclctFoundXMLs As MSHTML.IHTMLElementCollection
Dim htmlWebInterfaceXML As MSXML2.XMLHTTP60
Dim intNumberOfTradeUnderProcessing As Integer
UpdateProgressStatus "LOADING SERVER WITH SOURCE XML..." '<----------- UPDATE PROGRESS!
'----------------------> OPEN AND LOAD THE WEB SERVER, AND STORE ITS HTML INTO AN OBJECT
Set htmlWebInterfaceXML = New MSXML2.XMLHTTP
With htmlWebInterfaceXML
.Open "GET", p_cstrWebInterfaceXMLRootDirectory, False
.setRequestHeader "Authorization", "Basic" & Base64Encode( _
p_cstrXMLWebInterfaceAuthenticationUser & ":" & p_cstrXMLWebInterfaceAuthenticationPassword)
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
End With
htmlHTMLMainPageXMLInterface.body.innerHTML = htmlWebInterfaceXML.responseText ' how much text is the htmldocument able to store??
Set htmlWebInterfaceXML = Nothing
SetUpDirectory ' ------------> create or set directory where to store XML files
If Me.ContractiDs.Count <> Me.MailParts.Count And Me.ContractiDs.Count <> Me.MailParts.Count * 2 Then
Err.Raise 1504, "FileUpload", p_cstrError1504Message
Else
For Each vrntContractID In Me.ContractiDs
intNumberOfTradeUnderProcessing = intNumberOfTradeUnderProcessing + 1
UpdateProgressStatus "LOADING XML FOR THE TRADE NUMBER " & intNumberOfTradeUnderProcessing & "..." ' ----------------> UPDATE STATUS BAR
' ------------------------> find the tags containing the needed contract id in their names
Set htmclctFoundXMLs = htmlHTMLMainPageXMLInterface.getElementsByTagName("a")
Set clctStrFoundMatches = New Collection
For Each htmlTagElement In htmclctFoundXMLs
If htmlTagElement.getAttribute("href") Like "*" & vrntContractID & "*" Then
clctStrFoundMatches.Add htmlTagElement
End If
Next htmlTagElement
If clctStrFoundMatches.Count = 0 Then Err.Raise 1506, "FileUpload", p_cstrError1506Message
' -----------------------> exclude the archives from the collection
byteCounter = 0
For byteCounter = 1 To clctStrFoundMatches.Count
If blnContainsPattern("\.gz$", clctStrFoundMatches(byteCounter).innerText) Then
clctStrFoundMatches.Remove byteCounter
End If
Next byteCounter
' ----------------------> extract the contract ids and find the last contract id
Set clctInternalIDs = New Collection
For Each member In clctStrFoundMatches
clctInternalIDs.Add strReturnSingleMatch("\d{9}", member.innerText)
If clctInternalIDs(clctInternalIDs.Count) = "False" Then Err.Raise 1505, "FileUpload", p_cstrError1505Message
Next member
byteMaxID = FindMaximum(clctInternalIDs)
strPathToXMLFile = clctStrFoundMatches(byteMaxID).innerText
' -----------------------> check whether such file exists, and, if not, download it
If blnFileExists(strPathToXMLFile, p_cstrXMLDestination) Then
Else
strURLToXMLFile = p_cstrWebInterfaceXMLRootDirectory & strPathToXMLFile
Set htmlWebInterfaceXML = Nothing: Set htmlWebInterfaceXML = New MSXML2.XMLHTTP
htmlWebInterfaceXML.Open "GET", strURLToXMLFile, False
htmlWebInterfaceXML.setRequestHeader "Authorization", "Basic" & Base64Encode( _
p_cstrXMLWebInterfaceAuthenticationUser & ":" & p_cstrXMLWebIntervaceAuthenticationPassword)
htmlWebInterfaceXML.send
With domdocXMLText
.validateOnParse = False
.async = False
End With
domdocXMLText.LoadXML htmlWebInterfaceXML.responseText
domdocXMLText.Save p_cstrXMLDestination & "\" & strPathToXMLFile
End If
Next vrntContractID
End If
Set htmlHTMLMainPageXMLInterface = Nothing
End Sub
I had a similar problem that i solved. my script ran through a server and looked for a string in thousands of text files.
The way i solved it is (using ascync ServerXMLHTTP60) setting an if condition in the response handler to ABORT the xmlhttp object. After i was done comparing data, the object would get "dropped" out of memory, and now i can query (virtually) any amount of data. (took me about a month to test a lot of solution, and this was the right one)
This might work for you, so just add htmlWebInterfaceXML.abort after you are done with that data set.
Hope this helps! Cheers!
Hello fellow Excel vba coders
I have this great macro in my excel sheet, where i compile XML based on the rows the user puts in - after this it post the xml to a webservice.
You can have a look at my code below - It is fairly simple:
Set XMLHttpRequest = New MSXML2.XMLHTTP
With XMLHttpRequest
.Open "POST", URL, False
.setRequestHeader "Content-Type", "text/xml; encoding='utf-8'"
.setRequestHeader "Content-Length", strLength
.send strXML
End With
Right now it works great when there is less than 200 rows, yet it times out when the row number gets above 1000 rows. The string of XML I post is really big, and i'm quite sure that's the reason it times out.
Now my problem is, how do i post this huge dataset, that exceed 1.000 rows, maybe even above 20.000 rows, to a webservice?
So far i have spend a lot of time to look for a possible solution around the web, but have yet to find a way to handle this. So far i have the following ideas to solve the problem:
Copy the sheet to a new workbook, take the location of the new workbook and convert the file to a Base64 string and post the entire file to a new .asmx service and handle the "workbook" in C# code.
Convert the huge string to some kind of byte array and post that to a new .asmx webservice and handle the C# code.
I really hope one of you guys can point me in the right direction and help me solve this problem?
Instead of sending the entire sheet as a single object, send each row individually.
This will require your web service to be modified to accept just a row, rather than, what I would guess is currently being sent as an array of rows.
This would allow you to process any number of rows as the most you are processing at any one time is exactly one.
It is possible the issue of configuration on server side... See this post
and this.
Ok - I found a solution to my problem, and it seems like the best way to handle this problem.
I use the following function to make a copy of the workbook:
Private Function saveAS(Path As String)
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.Sheets.Copy
ActiveWorkbook.saveAS Path, FileFormat:=51
ActiveWorkbook.Close savechanges:=True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Function
Then i encode the file into a base64string, like so:
Private Function EncodeFileBase64(Filename As String) As String
Dim arrData() As Byte
Dim fileNum As Integer
Filename = Filename + ".xlsx"
fileNum = FreeFile
Open Filename For Binary As fileNum
ReDim arrData(LOF(fileNum) - 1)
Get fileNum, , arrData
Close fileNum
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeFileBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
And then i send the encoded string to my own .asmx webservice and work with it in C# The webmethod looks like this:
[WebMethod]
[ScriptMethod(UseHttpGet = true)]
public string UploadXML(string base64string)
{
try
{
byte[] bytes = Convert.FromBase64String(base64string);
using (MemoryStream ms = new MemoryStream(bytes))
{
using (var package = new ExcelPackage(ms))
{
ExcelWorkbook workBook = package.Workbook;
ExcelWorksheet settings = workBook.Worksheets.SingleOrDefault(w => w.Name == "sheet1");
ExcelWorksheet data = workBook.Worksheets.SingleOrDefault(w => w.Name == "sheet2");
//Getting data
string SS1 = (string)settings.Cells[8, 3].Value;
string ss2 = (string)settings.Cells[7, 3].Value;
}
}
return "success";
}
catch (Exception ee)
{
return ee.Message;
}
}
I just need to find a good way to pull out all the data in a smart algorithm, i dont think that will be a problem at all :)
I know you have a solution but I'd like to give an opinion...
If the data is really so tabular then shouldn't it be in a database like SQL Server? If you are uploading to a database then SQL Server has some nice bulk upload features to load workbooks efficiently.
I'm trying to scrap data from a website using MSXML2.XMLHTTP object on VBA environment (Excel) and I cannot figure out how to solve this problem! The website is the following:
http://www.detran.ms.gov.br/consulta-de-debitos/
You guys can use the following test data to fill the form:
Placa: oon5868
Renavam: 1021783231
I want to retrieve data like "chassi", with the data above that would be " 9BD374121F5068077".
I do not have problems parsing the html document, the difficult is actually getting the information as response! Code below:
Sub SearchVehicle()
Dim strPlaca As String
Dim strRenavam As String
strPlaca = "oon5868"
strRenavam = "01021783231"
Dim oXmlPage As MSXML2.XMLHTTP60
Dim strUrl As String
Dim strPostData As String
Set oXmlPage = New MSXML2.XMLHTTP60
strUrl = "http://www2.detran.ms.gov.br/detranet/nsite/veiculo/veiculos/retornooooveiculos.asp"
strPostData = "placa=" & strPlaca & "&renavam=" & strRenavam
oXmlPage.Open "POST", strUrl, False
oXmlPage.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oXmlPage.send strPostData
Debug.Print oXmlPage.responseText
End Sub
The strURL used in the POST method ".../retornooooveiculos.asp" is the one google developer tools and fiddler showed me that was the correct address the website was posting the payload.
When manually accessed, the website retrieve the correct information, but running my code I always get the following response on the .responseText:
<html>Acesse: <b><a href='http://www.detran.ms.gov.br target='_parent'>www.detran.ms.gov.br</a></b></html>
HELP PLEASE, I'm getting crazy trying to solve this puzzle! Why do I get redirected like this?
I need the "CHASSI" information and can't find the correct http Request to do this!
Try the below approach. It should fetch you the content you are after. The thing is you need to supply the Cookie copied from your Request Headers fields in order for your script to work which you can find using devtools.
Sub SearchVehicle()
Const URL As String = "http://www2.detran.ms.gov.br/detranet/nsite/veiculo/veiculos/retornooooveiculos.asp"
Dim HTTP As New ServerXMLHTTP60, HTML As New HTMLDocument
Dim elem As Object, splaca$, srenavam$, qsp$
splaca = "oon5868"
srenavam = "01021783231"
qsp = "placa=" & splaca & "&renavam=" & srenavam
With HTTP
.Open "POST", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "Cookie", "ISAWPLB{07D08995-E67C-4F44-91A1-F6A16337ECD6}={286E0BB1-C5F9-4439-A2CE-A7BE8C3955E0}; ASPSESSIONIDSCSDSCTB=AGDPOBEAAPJLLMKKIGPLBGMJ; 69137927=967930978"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send qsp
HTML.body.innerHTML = .responseText
End With
For Each elem In HTML.getElementsByTagName("b")
If InStr(elem.innerText, "Chassi:") > 0 Then MsgBox elem.ParentNode.NextSibling.innerText: Exit For
Next elem
End Sub
Once again: fill in the Cookie field by collecting it using your devtools (from Request Headers section), if for some reason my provided Cookie doesn't work for you. Thanks.
Output I'm getting:
9BD374121F5068077
I believe the Google API allows you to get coordinates for a given address. However, most (or should I say all) of the examples I've found aren't for vb. Usually it's some javascript example that just leaves me confused.
Here's some code I have that uses a geocoding service. This works great. It's just that I want to query Google Maps directly myself.
Public Function fgGetLatAndLongUsingAddress(sAddress As String) As String
'This function works best with a complete address including the zip code
Dim sResponseText As String, sReturn As String
sReturn = "none"
Dim objHttp As Object, sQuery As String
sQuery = "http://rpc.geocoder.us/service/csv?address=" & Replace(sAddress, " ", "+")
Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
objHttp.Open "GET", sQuery, False
objHttp.send
sResponseText = objHttp.ResponseText
gsLastLatLongResponseText = sResponseText
Set objHttp = Nothing
If Len(sResponseText) > 0 Then
If InStr(sResponseText, "Bad Request") > 0 Then
'Do Nothing
ElseIf InStr(sResponseText, "couldn't find this address") > 0 Then
'Do Nothing
Else
If InStr(sResponseText, vbCrLf) > 0 Then
'We got more than one result
End If
If InStr(sResponseText, ",") > 0 Then
Dim aryInfo() As String
aryInfo = Split(sResponseText, ",")
sReturn = aryInfo(0) & "," & aryInfo(1)
End If
End If
End If
fgGetLatAndLongUsingAddress = sReturn
End Function
This should do the job. You need to add a reference to the MSXML6 library (Microsoft XML, v6.0) via Tools > References in Excel
Option Explicit
Function getGoogleMapsGeocode(sAddr As String) As String
Dim xhrRequest As XMLHTTP60
Dim sQuery As String
Dim domResponse As DOMDocument60
Dim ixnStatus As IXMLDOMNode
Dim ixnLat As IXMLDOMNode
Dim ixnLng As IXMLDOMNode
' Use the empty string to indicate failure
getGoogleMapsGeocode = ""
Set xhrRequest = New XMLHTTP60
sQuery = "http://maps.googleapis.com/maps/api/geocode/xml?sensor=false&address="
sQuery = sQuery & Replace(sAddr, " ", "+")
xhrRequest.Open "GET", sQuery, False
xhrRequest.send
Set domResponse = New DOMDocument60
domResponse.loadXML xhrRequest.responseText
Set ixnStatus = domResponse.selectSingleNode("//status")
If (ixnStatus.Text <> "OK") Then
Exit Function
End If
Set ixnLat = domResponse.selectSingleNode("/GeocodeResponse/result/geometry/location/lat")
Set ixnLng = domResponse.selectSingleNode("/GeocodeResponse/result/geometry/location/lng")
getGoogleMapsGeocode = ixnLat.Text & ", " & ixnLng.Text
End Function
The only real differences to your example are:
changing the URL and parameters of the query to use the Google API
treating the response as an XML document and using XPath to extract the required results
Obviously there's no error handling whatsoever in my code but it should give you an idea of what you need to use the API. You definitely want to consult the API documentation yourself to find out about rate limiting etc
Thanks for that code! It works great. Thanks for the heads up on the rate limits. Here's what Google has to say:
Use of the Google Geocoding API is subject to a query limit of 2,500 geolocation requests per day. (User of Google Maps API Premier may perform up to 100,000 requests per day.) This limit is enforced to prevent abuse and/or repurposing of the Geocoding API, and this limit may be changed in the future without notice. Additionally, we enforce a request rate limit to prevent abuse of the service. If you exceed the 24-hour limit or otherwise abuse the service, the Geocoding API may stop working for you temporarily. If you continue to exceed this limit, your access to the Geocoding API may be blocked.
Note: the Geocoding API may only be used in conjunction with a Google map; geocoding results without displaying them on a map is prohibited. For complete details on allowed usage, consult the Maps API Terms of Service License Restrictions.