I'm writing a VBA code to check for access for my Database:
The code check if I have privilege to connect to a web server so it grants me access to the DB.
Function WebVer(ByVal StrUserName As String, ByVal StrPassword As String) As String
Dim Access As String
Dim objHTTP As Object
Dim URL As String
Dim Response As String
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://myweb.com/authenticator?app=WebDNC_server&service=authenticate&userid=" & StrUserName & "&password=" & StrPassword
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ("")
LDAPResponse = UCase(objHTTP.responseText)
If Response Like "*BAD*" Then
WebVer= "BAD PASSWORD"
ElseIf Response Like "*PASS*" Then
WebVer= "PASS"
ElseIf Response Like "*USERID*" Then
WebVer= "USERID Not RECOGNIZED"
Else
WebVer= "CONNECTION ERROR"
End If
End Function
Now everything is going fine except that if the user uses special characters in the password it returns BAD Password. I think there is a problem on how VBA handles Special characters but still do not know how to solve it. Any help would be appreciated.
I'm pretty sure you have to URL-encode the username and password.
See: How can I URL encode a string in Excel VBA?
Related
I'm trying to use a web API with Excel VBA.
In the API instructions it is written:
Using cURL
curl https://{subdomain}.zendesk.com/api/v2/users/create_or_update.json \
-d '{"user": {"name": "Roger Wilco", "email": "roge#example.org"}}' \
-H "Content-Type: application/json" -X POST \
-v -u {email_address}:{password}
Link to the API itself (Create or Update User) https://developer.zendesk.com/rest_api/docs/support/users#create-or-update-user
This is my code:
Public Function PostJsonRequest() As String
Dim strURL As String
Dim strParse() As String
Dim jsonStr As String
Dim hreq As Object
Dim tixScript As Object
On Error GoTo Er
Set hreq = CreateObject("MSXML2.XMLHTTP")
strURL = "https://subdomain.zendesk.com/api/v2/users/create_or_update"
hreq.Open "POST", strURL, 0, "username/token", "token"
hreq.setRequestHeader "User-Agent", "Chrome"
hreq.setRequestHeader "Content-Type", "application/json"
hreq.setRequestHeader "Accept", "application/json"
hreq.setRequestHeader "-v -u {MyEmail}:{MyPassword}"
jsonStr = "-d '{""user"": {""name"": ""Roger Wilco"", ""email"": ""roge#example.org""}}'"
hreq.Send jsonStr
MsgBox hreq.responseText
Exit Function
Er:
MsgBox "Error - " & Err.Number & " - " & Err.Description
End Function
In the Email and Password line I get this error:
Error - 450 - Wrong number of arguments or invalid property assignment
This is not valid hreq.setRequestHeader "-v -u {MyEmail}:{MyPassword}"
Try basic authentication instead
hreq.setRequestHeader "Authorization", "Basic dXNlcjpwYXNzd29yZA=="
where dXNlcjpwYXNzd29yZA== is the base64 encoded {MyEmail}:{MyPassword} string.
For example:
Dim username As String
username = "user123"
Dim password As String
password = "abc123"
hreq.setRequestHeader "Authorization", "Basic " & EncodeBase64(username & ":" & password)
Where the base64 encoding function works like this:
Private Function EncodeBase64(ByVal plainText As String) As String
Dim bytes() As Byte
Dim objXML As Object 'MSXML2.DOMDocument60
Dim objNode As Object 'MSXML2.IXMLDOMNode
bytes = StrConv(plainText, vbFromUnicode)
Set objXML = CreateObject("MSXML2.DOMDocument.6.0")
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = bytes
EncodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
Also make sure you only send the JSON part without the -d '…':
jsonStr = "{""user"": {""name"": ""Roger Wilco"", ""email"": ""roge#example.org""}}"
Finally a more cosmetic thing than an issue:
hreq.setRequestHeader "User-Agent", "Chrome"
Either set your user agent string to fake a real user agent, for a current chrome it would look like:
Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36
Faking a user agent is to make the website think you are surfing with a Chrome for example. For the API this is not necessary I guess, so you can set it to something generic like:
hreq.setRequestHeader "User-Agent", "MyVBAProject Version x.y.z Windows 10 using MSXML2.XMLHTTP"
to show the website clearly which type of application you are.
At least don't set it to "Chrome" as this is just confusing as Chrome would never use that user agent.
I am trying to create an Excel macro to send cell data to a URL using a POST request. I have chosen to format that data using JSON, because there is a lot of it to send. Here is my code for sending the JSON:
Dim jFullDictionary As New Dictionary ' This dictionary contains a Collection
...
Dim JsonURL As String
JsonURL = "http://myurl.com"
Dim JsonHTTP As New MSXML2.XMLHTTP
Set JsonHTTP = CreateObject("MSXML2.XMLHTTP")
Dim JsonString As String
JsonString = JsonConverter.ConvertToJson(jFullDictionary, Whitespace:=3)
With JsonHTTP
.Open "POST", JsonURL, False
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send JsonString ' This is where the program breaks
End With
Every time I run this, I get the error that says (something along the lines of)
Run time error: Could not find the resource specified
I have already looked at these StackOverflow threads, but I've gotten nowhere:
Error from VB excel macro code - msxml3.dll -2146697211 The system cannot locate the resource specified
Sending JSON POST request in VBA
Additionally, I have tried installing Tim Hall's project from here, but the installation doesn't work on my machine (might be because it's a work computer).
The error makes me think that it has something to do with the resources that I have loaded, but I'm not sure. If it's not that, then there is something wrong with my code. Any help would be appreciated, thank you.
Edit:
Here is the loop that I use to fill the jFullDictionary with my data:
Dim jDictionary As New Dictionary
Dim jCollection As New Collection
Dim jFullDictionary As New Dictionary
For i = 1 To excelRange.Rows.Count
For j = 1 To excelRange.Columns.Count
jDictionary("row") = i
jDictionary("name") = Cells(5, j) ' This assignment is arbitrary
jDictionary("value") = Cells(i + 1, j) ' so is this
jCollection.Add jDictionary
Set jDictionary = Nothing
Next j
Next i
jFullDictionary.Add "parametersList", jCollection
I'm attempting to pull data from a JSON file on the web. I'm using a dummy JSON file for the time being to get things working. My code is below, but it times out every time and doesn't return anything. The same happens if I use different URLs also.
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.Send
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
In case it's relevant, I have the following libraries enabled in the file:
Visual Basic for Applications
Microsoft Excel 15.0 Object Library
OLE Automation
Microsoft Scripting Runtime
Microsoft WinHTTP Services, version 5.1
What am I missing?
EDIT: Fixed. I wasn't aware of the distinction between WinHttpRequest and XMLHTTPRequest. When using the latter, the code worked fine. Thanks all.
Is there a special reason why using WinHttpRequest instead of XMLHTTPRequest?
While using WinHttpRequest the operating system defaults for HTTP requests - proxy settings for example - are not used and must be set explicitly:
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.SetProxy 2, "proxyIP:proxyPort"
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.setCredentials "username", "password", 1
objHTTP.Send
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
The 2 in IWinHttpRequest::SetProxy method is HTTPREQUEST_PROXYSETTING_PROXY.
The 1 in IWinHttpRequest::SetCredentials method is HTTPREQUEST_SETCREDENTIALS_FOR_PROXY.
While using XMLHTTPRequest the operating system defaults for HTTP requests are used as set in Internet Options in control panel. So the following should run if you are able accessing the URL via browser:
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.Send
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
Your code works OK here, but perhaps you should .WaitForResponse if things are timing out:
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.Send
objHTTP.waitforresponse
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
I currently have a spreadsheet where a macro creates a JSON string and posts it to a web service using HTTP. On windows this code works fine for this:
Private Sub pvPostString(sUrl As String, sString As String, sFileName As String, Optional ByVal bAsync As Boolean)
Const STR_BOUNDARY As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim nFile As Integer
Dim baBuffer() As Byte
Dim sPostData As String
Dim connUrl As String
sPostData = sString
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", sUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.Send pvToByteArray(sPostData)
End With
End Sub
However on the latest Mac Excel I get an error "ActiveX component can't create object". This makes sense as MSXML2.XMLHTTP is a Microsoft solution, however it means I need to find a replacement function.
I've done lots of googling on this matter and from what I have read I may be able to achieve this using query tables. However, I have tried all sorts of configurations but with no joy. For example if I try the following then I get the error "Invalid web query"
With ActiveSheet.QueryTables.Add(Connection:=connUrl, Destination:=Range("C30"))
.PostText = myJSONString
.RefreshStyle = xlOverwriteCells
.SaveData = True
.Refresh
End With
This makes sense as JSON isn't valid post text, though at the same time posting a lengthy JSON file as post text doesn't really seem like the right solution.
Ideally I would like to post the JSON as a file so that it can be referenced on the server by $_FILES[]. Though from what I've read it isn't clear on how to do this (or if it is possible at all).
tldr; Ultimately my objective with this is to have a function that allows me to post a lengthy JSON string via http that will work on both Windows and Mac. I would really appreciate any help on this.
VBA-Web (previously Excel-REST) supports both Windows in Mac in v4.0.0 and allows you to GET, POST, PUT, PATCH, and DELETE from VBA. I haven't tried it with file uploads, so I'm not sure it will work in your case, but I'd give it a try. Here's a sample:
' Replace with the following
' With CreateObject("MSXML2.XMLHTTP")
' .Open "POST", sUrl, bAsync
' .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
' .Send pvToByteArray(sPostData)
' End With
' Client for executing requests
Dim Client As New WebClient
' Generally set Client.BaseUrl here, but it's not required
' Request for setting request details
Dim Request As New WebRequest
Request.Method = WebMethod.HttpPost
Request.Resource = sUrl
Request.ContentType = "multipart/form-data; boundary=" & STR_BOUNDARY
' Execute request and store response
Dim Response As WebResponse
Set Response = Client.Execute(Request)
I am attempting to send a POST URL message from MS Access VBA. When I attempt to run the code, it tells me that is not able to compile the following statement. Does anyone have any idea where I am incorrect in my syntax? Thank you in advance for assistance.
objHTTP.Open "POST", "http://kt1.com/apiv2/Configuration.asmx", False
The full code is:
Private Sub newKT_WebService_Click()
Dim objHTTP As String
Dim replyTXT As String
Dim AuthCode As String
objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "POST", "http://kt1.com/apiv2/Configuration.asmx", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send ("CallingID=12345&token=%20&domain=%20&userName=testuser&password=testpassword")
MsgBox objHTTP.responseText
End Sub
objHTTP was declared as String. But later the code attempts to assign an object reference to it. So declare objHTTP as Object. And you must use the Set keyword to assign to the object variable.
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "POST", "http://kt1.com/apiv2/Configuration.asmx", False
I'm not really familiar with MSXML2.ServerXMLHTTP but hopefully those changes will allow the code to compile and do what you need.