There is simple code for upload file to dropbox.
Does someone have an example of a similar code for Onedrive
Function uploadSave(stm As ADODB.Stream, fname As String, token As String) As integer
Const lngTimeout = 890000
Dim http As WinHttp.WinHttpRequest
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
http.Open "POST", "https://content.dropboxapi.com/2/files/upload", False
http.setRequestHeader "Content-Length", stm.Size
http.setRequestHeader "Authorization", "Bearer " & token
http.setRequestHeader "User-Agent", "api-explorer-client"
http.setRequestHeader "Content-Type", "application/octet-stream"
http.setRequestHeader "Dropbox-API-Arg", "{""path"":""" & fname & """,""mode"":{"".tag"":""overwrite""},""autorename"":true}"
http.Send (stm.Read)
Set stm = Nothing
uploadSave = http.Status
End Function
Related
I'm trying to build a VBA function that will update a value in a Sharepoint list:
Sub testUpdate()
Dim XmlHttp As MSXML2.XMLHTTP60
Dim result As String
Dim url As String
Dim body As String
Dim RequestDigest As String
Set XmlHttp = New MSXML2.XMLHTTP60
url = "https://sps.utility.xyz.com/sites/xyz/_api/web/lists/GetByTitle('REST Test List')/items(1)"
RequestDigest = GetDigest("https://sps.utility.xyz.com/sites/xyz")
body = "{ '__metadata': { 'type': 'SP.Data.REST_x0020_Test_x0020_ListListItem' }, 'Title': 'updating item with new title'}"
XmlHttp.Open "POST", url, False
XmlHttp.setRequestHeader "IF-MATCH", "*"
XmlHttp.setRequestHeader "accept", "application/json;odata=verbose"
XmlHttp.setRequestHeader "content-type", "application/json;odata=verbose"
XmlHttp.setRequestHeader "X-Http-Method", "MERGE"
XmlHttp.setRequestHeader "X-RequestDigest", RequestDigest
XmlHttp.setRequestHeader "Content-Length", Len(body)
XmlHttp.Send body
result = XmlHttp.responseText
End Sub
Function GetDigest(url As String)
Dim oHttp As New MSXML2.XMLHTTP60
Dim s As String
Dim l1 As Long
Dim l2 As Long
With oHttp
.Open "POST", url + "/_api/contextinfo", False
.setRequestHeader "content-type", "application/json;odata=verbose"
.Send ""
End With
s = oHttp.responseText
l1 = InStr(1, s, "FormDigestValue")
If l1 > 10 Then
l1 = l1 + 16
l2 = InStr(l1, s, "</d:FormDigestValue")
End If
If l2 > 10 Then GetDigest = Mid$(s, l1, l2 - l1)
Set oHttp = Nothing
End Function
But when testUpdate gets to the line:
XmlHttp.Send body
it throws this error:
Run-time error '-2147467260 (80004004)':
Operation aborted
Despite the error, the update succeeds--the list item's Title value changes.
Is it safe for me to simply handle this exception and bypass the error, or is it indicating that there is a real problem that I need to resolve?
The api call requires authentication. I managed to use WinHTTP to authenticate the request based on the current user, I am assuming that they have access in the below. I get a 204 response and my list item updates correctly. (the iteration is because I was testing performance and can be removed).
Tools>references>Microsoft WinHttp Services Version 5.1
Private Sub UpdateItem2(ID, strFormDigest As String, iteration)
Dim sUrl As String
sUrl ="https://123.Sharepoint.net/sites/123/_api/web/lists/getbytitle('MyDemoList')/items(" & ID & ")"
Dim oRequest As WinHttp.WinHttpRequest
Dim sResult As String
sEnv = "{ '__metadata': { 'type': 'SP.Data.MyDemoListListItem' }, 'Title': 'TEST" & iteration & "' }"
Set oRequest = New WinHttp.WinHttpRequest
With oRequest
.Open "POST", sUrl, True
.setRequestHeader "IF-MATCH", "*"
.setRequestHeader "X-HTTP-Method", "MERGE"
.setRequestHeader "accept", "application/json;odata=verbose"
.setRequestHeader "X-RequestDigest", strFormDigest
.setRequestHeader "content-type", "application/json;odata=verbose"
.SetAutoLogonPolicy AutoLogonPolicy_Always
.send sEnv
.waitForResponse
End With
End Sub
New to the community here. I've done a decent amount of programming but I'm completely new to VBA. Never used it before until now and I was tasked with extracting JSON data from a Jira API into an Excel spreadsheet. I keep getting the error "Run-Time error '13': Type mismatch" and I'm not sure why. I know the error has to do with passing in incorrect types but I've tried changing the Json variable to a String with no success. Anyone have any ideas? Thanks!
By the way, this is just a trial Jira instance for testing the API functionality.
Sub test()
'Authenticate the user
Dim response As String
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", "https://apitestsite.atlassian.net/rest/auth/1/session", False, "admin", "password"
.setRequestHeader "X-Atlassian-Token:", "nocheck"
.Send
response = .responseText
End With
'Query through JSON
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", "https://apitestsite.atlassian.net/rest/api/2/issue/CC-1", False, "admin", "password"
MyRequest.Send
Dim Json As Object
Set Json = JsonConverter.ParseJson(MyRequest.responseText)
MsgBox Json("fields")("summary")
End Sub
UPDATE: This is where I am at right now. Updated the code for the authentication and now no errors display from the compiler. Here is the JSONConverter class I am using: github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas. The issue now is that the returned JSON string says, "{"errorMessages":["Issue does not exist or you do not have permission to see it."],"errors":{}}". So I am able to connect to Jira just fine and return the JSON as a string, it's just that Jira is rejecting my credentials :/
Private JiraService As New MSXML2.XMLHTTP60
Private JiraAuth As New MSXML2.XMLHTTP60
Sub test()
'Authenticate the user
With JiraAuth
.Open "POST", "https://apitestsite.atlassian.net/rest/auth/1/session", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "X-Atlassian-Token:", "nocheck"
.send " {""username"" : ""admin"", ""password"" : ""password""}"""
sErg = .responseText
sCookie = "JSESSIONID=" & Mid(sErg, 42, 32) & "; Path=/Jira" '*** Extract the Session-ID
End With
With JiraService
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", "https://apitestsite.atlassian.net/rest/api/2/issue/CC-1", False
MyRequest.setRequestHeader "Content-Type", "application/json"
MyRequest.setRequestHeader "Accept", "application/json"
MyRequest.setRequestHeader "Set-Cookie", sCookie '*** see Create a "Cookie"
MyRequest.send
Dim Json As String
Json = MyRequest.responseText
MsgBox Json
End With
End Sub
This seems to return a valid JSON from the API, which is parseable from the Jsonconverter module.
You were using MyRequest object as possibly the wrong type of object. Elsewhere, you're relying on the MSXML2.XMLHTTP60 class.
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
So I removed the MyRequest and just worked with the JiraService object instead. You had a With JiraService block but you weren't actually using that object at all, you were executing against the WinHttpRequest object within that block.
I also declared all variables, and modified the auth string to use Const strings defined at top of module for user/password.
Option Explicit
Private JiraService As New MSXML2.XMLHTTP60
Private JiraAuth As New MSXML2.XMLHTTP60
Const user As String = "jiratestemail82#gmail.com"
Const pw As String = "password"
Sub test()
Dim sErg$, sCookie$, Json$
'Authenticate the user
With JiraAuth
.Open "POST", "https://apitestsite.atlassian.net/rest/auth/1/session", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "X-Atlassian-Token:", "nocheck"
.send " {""username"" : """ & user & """, ""password"" : """ & pw & """}"""
sErg = .responseText
sCookie = "JSESSIONID=" & Mid(sErg, 42, 32) & "; Path=/Jira" '*** Extract the Session-ID
End With
With JiraService
.Open "GET", "https://apitestsite.atlassian.net/rest/api/2/issue/CC-1", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Set-Cookie", sCookie '*** see Create a "Cookie"
.send
Json = .responseText
End With
Dim j As Object
Set j = JsonConverter.ParseJson(Json)
MsgBox j("fields")("summary")
End Sub
I'm using MSXML2.XMLHTTP60 for http surfing in my VBA project. The issue is MSXML2.XMLHTTP60 is limited to four concurrent requests.
I'm trying to use WinHttp.WinHttpRequest.5.1 instead, and there is another issue. MSXML2.XMLHTTP60 parses gzip result automatically, but
WinHttpRequest.responseText method fails with error:
No mapping for the unicode character exists in the target multi-byte code page.
How can I parse this result with standard Windows libraries?
Code examples:
MSXML2.XMLHTTP60 limitation:
Public req1 As MSXML2.XMLHTTP60
Public req2 As MSXML2.XMLHTTP60
Public req3 As MSXML2.XMLHTTP60
Public req4 As MSXML2.XMLHTTP60
Public req5 As MSXML2.XMLHTTP60
Private Const url As String = "http://speedtest.tele2.net/100MB.zip"
Public Sub ConcurrentIssue()
Set req1 = New MSXML2.XMLHTTP60
req1.Open "get", url, True
Set req2 = New MSXML2.XMLHTTP60
req2.Open "get", url, True
Set req3 = New MSXML2.XMLHTTP60
req3.Open "get", url, True
Set req4 = New MSXML2.XMLHTTP60
req4.Open "get", url, True
Set req5 = New MSXML2.XMLHTTP60
req5.Open "get", url, True
req1.send
req2.send
req3.send
req4.send
'This query will be wait
req5.send
End Sub
Problem is that WinHttp.WinHttpRequest.5.1 does not support decompression (proof link: https://msdn.microsoft.com/ru-ru/library/windows/desktop/hh227298(v=vs.85).aspx).
I need to decompress the response myself.
Decompression issue example:
Public Sub DecompressOk()
Set req1 = New MSXML2.XMLHTTP60
req1.Open "get", "http://www.google.ru", False
req1.setRequestHeader "User-Agent", "Fiddler"
req1.setRequestHeader "Accept-Encoding", "gzip, deflate"
req1.send
Debug.Print req1.responseText
End Sub
Public Sub WithoutDecompress()
Dim req As WinHttp.WinHttpRequest
Set req = New WinHttp.WinHttpRequest
req.Open "get", "http://www.google.ru", False
req.setRequestHeader "User-Agent", "Fiddler"
req.setRequestHeader "Accept-Encoding", "gzip, deflate"
req.send
Debug.Print req.responseText
End Sub
I was trying to do this trick without success:
Public Sub DecompressIssue()
Dim req As WinHttp.WinHttpRequest
Set req = New WinHttp.WinHttpRequest
req.Open "get", "http://www.google.ru", False
req.setRequestHeader "User-Agent", "Fiddler"
req.setRequestHeader "Accept-Encoding", "gzip, deflate"
req.send
SaveBinaryToFile req.responseBody, "C:\test.zip"
Dim xmlReq As MSXML2.XMLHTTP60
Set xmlReq = New MSXML2.XMLHTTP60
xmlReq.Open "get", "C:\test.zip", False
xmlReq.setRequestHeader "Accept-Encoding", "gzip, deflate"
xmlReq.setRequestHeader "Content-Type", "text/html; charset=windows-1251"
xmlReq.send
Debug.Print xmlReq.responseBody
End Sub
Sub SaveBinaryToFile(arrBytes() As Byte, strPath As String)
With CreateObject("ADODB.Stream")
.Type = 1 ' adTypeBinary
.Open
.Write arrBytes
.SaveToFile strPath, 2 ' adSaveCreateOverWrite
.Close
End With
End Sub
This answer confirms the comment made by omegastripes.
.setRequestHeader "Accept-Encoding", "identity" is the right answer!
I've searched for days for a way to decode the gzipped response, but wasn't aware we could tell the server to not compress the response.
I was using this method to login to betfair api. Everything works fine, but after Windows 10 update (KB3140741) not working anymore. ResponseText = {"loginStatus":"CERT_AUTH_REQUIRED"} Anyone solved this?
Windows 10 Build 10586.218, version 1511
Microsoft Office 2016
Dim oHTTP As Object: Set oHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
Dim uri As String: uri = "https://identitysso.betfair.com/api/certlogin"
oHTTP.Open "POST", uri, False
oHTTP.SetClientCertificate "Common Name"
oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.setRequestHeader "X-Application", App_key
oHTTP.setRequestHeader "Accept", "application/json"
oHTTP.send "username=" & UserName & "&password=" & Password & ""
I would try with Msxml2.ServerXMLHTTP.6.0 instead :
Const uri = "https://identitysso.betfair.com/api/certlogin"
Dim req As Object
Set req = CreateObject("Msxml2.ServerXMLHTTP.6.0")
req.Open "POST", uri, False
req.setOption 2, 13056 ' ignore all certificate errors '
req.setOption 3, "Common Name" ' set the client certificate from the local store '
req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
req.setRequestHeader "X-Application", App_key
req.setRequestHeader "Accept", "application/json"
req.send "username=" & UserName & "&password=" & Password & ""
The following is the HTML of part of a web page.
"input name="ctl00$ctl00$AllContent$ContentMain$ucMktStatCtl$txtDate" type="text"
id="ctl00_ctl00_AllContent_ContentMain_ucMktStatCtl_txtDate"
onkeypress="javascript:return fnTrapKD(event, document.getElementById('ctl00_ctl00_AllContent_ContentMain_ucMktStatCtl_butReport'))"
value="02/24/2006" class="hasDatepicker">
I tried to use the following code to access the data.
Dim strPostData As String: strPostData = "ctl00$ctl00$AllContent$ContentMain$ucMktStatCtl$txtDate=02/24/2006"
Dim xmlhttp: Set xmlhttp = CreateObject("msxml2.xmlhttp.3.0")
xmlhttp.Open "POST", "http://www.cboe.com/data/mktstat2.aspx#VIX", False
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send (strPostData)
I am getting responsetext with 404 - File or directory not found. But the site does accept the input in a browser.
The mozilla firefox addon firebug helps to analyse the http request.
Post tab shows the parameters which are sent.
The URL should be http://www.cboe.com/data/mktstat2.aspx
Sub test()
Dim strPostData As String
strPostData = "ctl00$ctl00$AllContent$ContentMain$ucMktStatCtl$butReport=Get Report&ctl00$ctl00$AllContent$ContentMain$ucMktStatCtl$ddlNav=&ctl00$ctl00$AllContent$ContentMain$ucMktStatCtl$txtDate=05/31/2013&ctl00$ctl00$AllContent$ucHeader$CBOEHeaderSearchBox$txtHeaderSearch=Search&ctl00$ctl00$AllContent$ucHeader$ucCBOEHeaderQuoteBox$txtHeaderQuote=Quote"
Dim xmlhttp As Object
Set xmlhttp = CreateObject("msxml2.xmlhttp")
xmlhttp.Open "POST", "http://www.cboe.com/data/mktstat2.aspx", False
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send (strPostData)
MsgBox xmlhttp.responseText
End Sub