I am trying to connect my Access db To Wallmart's API and i get this error..
{"error":[{"code":"SYSTEM_ERROR.GMP_GATEWAY_API","info":"System encountered some internal error.","severity":"ERROR","category":"DATA","causes":[],"errorIdentifiers":{}}]}
this is my code:
Dim s As String
Dim xmlhttp As New MSXML2.XMLHTTP60
Me.Refresh
WalmartAPIUserKey =...
WalmartSecretKey=....
encodeData = Base64Encode(WalmartAPIUserKey & ":" & WalmartSecretKey)
xmlhttp.Open "POST", "https://marketplace.walmartapis.com/v3/token", False
xmlhttp.setRequestHeader "Authorization", "Basic " & encodeData
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.setRequestHeader "Accept", "application/json"
xmlhttp.setRequestHeader "WM_SVC.NAME", "Walmart Marketplace"
xmlhttp.setRequestHeader "WM_QOS.CORRELATION_ID", "123456789c"
xmlhttp.setRequestHeader "WM_CONSUMER.CHANNEL.Type", "........"
s = "grant_type=client_credentials"
xmlhttp.send s
MsgBox (xmlhttp.responseText)
Debug.Print (xmlhttp.responseText)
Does anyone have an idea what is wrong here?
Related
Below code is where I get 401 Unautorized access error After 2nd request Rest API is called .
Here is the developer Rest API documentation supplied.
https://simplybook.me/en/api/developer-api/tab/rest_api#method_GET_/admin/bookings/{id}
Sub Test()
Dim objRequest As Object
Dim loginResponse As Object
Dim strUrl As String
Dim bookingcode As String
Dim blnAsync As Boolean
Dim strloginResponse, strBookingresponse, strlogoutresponse, strparameter As String
Dim scriptControl As Object
Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
scriptControl.Language = "JScript"
Set objRequest = CreateObject("MSXML2.XMLHTTP")
'strUrl = "https://user-api.simplybook.me/admin/auth"
strUrl = "https://user-api-v2.simplybook.me/admin/auth"
blnAsync = True
'strUrl = "https://user-api.simplybook.me/admin/auth"
strUrl = "https://user-api-v2.simplybook.me/admin/auth"
With objRequest
.Open "POST", strUrl, blnAsync
.SetRequestHeader "Content-Type", "application/json"
.Send ("{""company"":""simplydemo"",""login"":""admin"",""password"":""demo""}")
'spin wheels whilst waiting for response
While objRequest.readyState <> 4
DoEvents
Wend
strloginResponse = .responsetext
End With
Set loginResponse = scriptControl.Eval("(" + strloginResponse + ")")
Debug.Print loginResponse.token
Debug.Print loginResponse.company
Debug.Print loginResponse.login
Debug.Print loginResponse.refresh_token
Debug.Print loginResponse.domain
Debug.Print loginResponse.require2fa
Debug.Print loginResponse.allowed2fa_providers
Debug.Print loginResponse.auth_session_id
bookingcode = "0bz29vl4t"
strUrl = "https://user-api-v2.simplybook.me/admin/bookings/" & bookingcode
'strUrl = "https://user-api.simplybook.me/admin/bookings/" & bookingcode
strparameter = "(""{""X-Company-Login"":""" & loginResponse.company & """,""X-Token"":""" & loginResponse.token & """}"")"
Debug.Print strparameter
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "GET", strUrl, blnAsync
.SetRequestHeader "Content-Type", "application/json"
.Send strparameter
'spin wheels whilst waiting for response
While objRequest.readyState <> 4
DoEvents
Wend
strBookingresponse = .responsetext
End With
Debug.Print strBookingresponse
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "https://user-api-v2.simplybook.me/admin/auth/logout"
strparameter = "(""{""auth_token"":""" & loginResponse.token & """}"")"
With objRequest
.Open "POST", strUrl, blnAsync
.SetRequestHeader "Content-Type", "application/json"
.Send strparameter
'spin wheels whilst waiting for response
While objRequest.readyState <> 4
DoEvents
Wend
strlogoutresponse = .responsetext
End With
Debug.Print strBookingresponse
Set scriptControl = Nothing
Set objRequest = Nothing
Set loginResponse = Nothing
End Sub
Below response is i get for the Debug.print statements:
4eb8b7f6ce820c24e66a754557635ede02e6e808ce27e311511a20bef4ed44e3
simplydemo
admin
b60ee1e89264ee5e856583fc20e63926e71a25bded9f9a540d12d5ccbf51bf51
simplybook.me
False
("{"X-Company-Login":"simplydemo","X-Token":"4eb8b7f6ce820c24e66a754557635ede02e6e808ce27e311511a20bef4ed44e3"}")
{"code":401,"message":"Unauthorized","data":[],"message_data":[]}
{"code":401,"message":"Unauthorized","data":[],"message_data":[]}
I have created a project in Ms Access which creates customer accounts on Stripe. Credit card stuff is via elements in a secure manner.
The situation:
It is running on my test (home) environment fine.
It was running at my business for 2 days
Today I used it and am now getting:
The Connection with the server was terminated abnormally
Code:
reqBody = "description=" & desc & _
"&name=" & pName & _
"&phone=" & pPhone & _
"&address[line1=" & pAdd & _
"&address[city=" & pSuburb & _
"&address[country=AU" & _
"&address[postal_code=" & pPCode & _
"&address[state=Western Australia"
Set httpReq = CreateObject("MSXML2.ServerXMLHTTP")
httpReq.Open "POST", "https://api.stripe.com/v1/customers", False
httpReq.setRequestHeader "Authorization", "Bearer " & api_key
httpReq.send reqBody
strResponse = httpReq.responseText
Set parsed = JsonConverter.ParseJson(strResponse)
'Debug.Print strResponse
StripeCustID = parsed("id")
Now I read some other posts and tried using:
httpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
and still no luck,
I ahve also tried:
Dim HTTPRequest As WinHttp.WinHttpRequest
Set HTTPRequest = New WinHttp.WinHttpRequest
With HTTPRequest
.Open "POST", "https://api.stripe.com/v1/customers", True
.setRequestHeader "Authorization", "Bearer " & api_key
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_TLS1_2
'.Option(WinHttpRequestOption_EnableRedirects) = True
.send reqBody
If .waitForResponse(3) Then
strResponse = .responseText
Debug.Print .responseText
Else
MsgBox "Timed out after 3 seconds."
Exit Sub
End If
End With
But with this it is coming up as [SecureProtocol_TLS1_2] not defined (I have the reference to WinHttp)
My test environment is Windows 10, my work on is Windows 7, both are 64x.
But the fact remains, this was working for two days on the work computers and now giving me this error.
In VBA, I currently have code that returns a CSV string from the internet. However, it seems like the entire file is not being captured when I try to store it in a string variable using .responseText
I've heard string sizes are limited, which makes this problem understandable (I'm trying to store 1000 rows of data into a variable - which is probably not possible). I was wondering if there is a way to download the CSV file straight from the source given that I have the URL to get the response? Here is the relevant code that I have:
Dim JiraReq As New MSXML2.XMLHTTP60
With JiraReq
' Create Session
downloadUrl = https://myurlishere.atlassian.net
' This is not the actual form of the URL, but it does
' successfully grab the CSV string (but the string variable
' will not store all of it - probably because of the size)
.Open "GET", downloadUrl, False
.setRequestHeader "Authorization", "Basic " + EncodeBase64(username + ":" + password)
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.send
End With
CSVData = JiraReq.responseText
If JiraReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write JiraReq.responseText
Filename = "C:\file" & i & ".csv"
oStream.SaveToFile Filename, 2
oStream.Close
End If
For reference, I have looked at the following links to try to solve this issue:
Arguments out of acceptable range
Downloading file from web with VBA
HTTP response text returning incomplete Data
My code ended up looking like this:
For i = 1 To pageCount Step 1
' MsgBox "Entering For Loop"
Dim startNumber As Integer
startNumber = (i - 1) * 1000
Dim downloadUrl As String
downloadUrl = "https://myurl.atlassian.net/sr/jira.issueviews:searchrequest-csv-current-fields/" & CStr(filterID) & "/SearchRequest-" & CStr(filterID) & ".csv?tempMax=1000&pager/start=" & CStr(startNumber)
With JiraReq
' Create Session
Debug.Print "Getting page " & CStr(i) & " of " & CStr(pageCount)
.Open "GET", downloadUrl, False
.setRequestHeader "Authorization", "Basic " + EncodeBase64(username + ":" + password)
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.send
End With
file_name = "C:\VBA\file" & i & ".csv"
If JiraReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write JiraReq.responseBody
oStream.SaveToFile file_name, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
I had to change from .responseText to .responseBody.
I am working on a procedure, in MS-Access VBA, to POST an XML text string to a web service and process the XML text string that is returned from the service.
The issue I am having is that the responseText property is always empty when it should contain a XML text string. No errors are returned and the .status = "OK".
I have tried the WinHttp.WinHttpRequest, MSXML2.XMLHTTP, and MSXML2.ServerXMLHTTP objects and consistently have the same issue.
Here is a code example:
Public Function Send() As Boolean
Dim oXHR As MSXML2.XMLHTTP60
Dim sURL, sCred As String
Dim sRequest, sResult, sStatus, sHeader As String
Dim bRtn As Boolean
BuildReqXML
sRequest = Me.RequestXML_String
With orsValues
sURL = .Fields("WebServiceURL").Value
sCred = Base64Encode(Trim(.Fields("User").Value) & ":" & Trim(.Fields("Password").Value))
End With
Set oXHR = New MSXML2.XMLHTTP60
With oXHR
.Open "POST", sURL, False
.SetRequestHeader "Authorization", "Basic " & sCred & """"
.SetRequestHeader "User-Agent", "Mozilla/4.0"
.SetRequestHeader "Content-Type", "text/xml"
.Send sRequest
sStatus = .StatusText
sResult = .ResponseText
sHeader = .GetAllResponseHeaders
If sResult <> "" Then
If Contains(sResult, "<") Then ReadXML sResult, "Response"
Debug.Print sResult
Else
Debug.Print sHeader
Debug.Print sRequest
End If
End With
Set oXHR = Nothing
End Function
I have verified that the web service is working correctly by building a similar call in a HTML document, sending the XML string, and receiving the response XML string.
Can someone please help me fix my issue?
I found the problem, with help from Fiddler.
The line setting the authorization header
.SetRequestHeader "Authorization", "Basic " & sCred & """"
Was adding a (") to the header line. The corrected line is
.SetRequestHeader "Authorization", "Basic " & sCred
Thank you for your help
This is the code and I get the above msg when I run it and F8 on the line described below. Have to click the OK button 17 times before I can get out of it. Happens for a few web pages only, the rest (1000s) work fine. Tried On Error Resume Next before and after the line with no effect. Any idea how the code can ignore the msg and proceed?
Dim XMLHTTP As Object
Dim myURL As String
Dim html As Object
With CreateObject("MSXML2.serverXMLHTTP")
.Open "GET", myURL, False
.setRequestHeader "Content-Type", "text/xml"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
On Error Resume Next
.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = .ResponseText 'getting the err msg here when I F8 on this line
End With
Have you tried
On Error Resume Err_Label
Dim XMLHTTP As Object
Dim myURL As String
Dim html As Object
With CreateObject("MSXML2.serverXMLHTTP")
.Open "GET", myURL, False
.setRequestHeader "Content-Type", "text/xml"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = .ResponseText 'getting the err msg here when I F8 on this line
End With
Exit sub
err_label:
'any error logging/reporting goes here
exit sub