I currently have this to download a file from SharePoint, and it is working,
Dim WinHttpReq As Object
Dim oStream As Object
myURL = "https://sharepoint..../my_folder/" & "File_I_want.PDF"
download_location = "C:\Users\username\Downloads\"
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "", ""
WinHttpReq.Send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile download_location & "File_I_want.PDF", 2
oStream.Close
End If
However the "File_I_Want" isn't always named the same, so trying to create a loop that first loops through all the files in,
myURL = "https://sharepoint..../my_folder/"
Related
I am trying to download a macro enabled file (xlsm) from Jira, I have tried the below method and able to download the file but the file is corrupted. Please advice what I am missing here.
Dim myURL As String
myURL = "Put your download link here"
Dim HttpReq As Object
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
HttpReq.Open "GET", myURL, False, "username", "password"
HttpReq.send
myURL = HttpReq.responseBody
If HttpReq.Status = 200 Then
Set oStrm = CreateObject("ADODB.Stream")
oStrm.Open
oStrm.Type = 1
oStrm.Write HttpReq.responseBody
oStrm.SaveToFile ThisWorkbook.Path & "\" & "file.xlsm", 2 ' 1 = no overwrite, 2 = overwrite
oStrm.Close
End If
(source)
Finally after several attempts, below code work, hope this is helpful for others.
Private Sub DownloadFromJira()
Dim oJiraService As MSXML2.ServerXMLHTTP60
Dim sPath As String
Dim sStatus As String
Dim FileData() As Byte
Dim FileNum As Long
Set oJiraService = New MSXML2.ServerXMLHTTP60
sPath = "C:\Users\**ID**\Downloads\Test.xlsm"
With oJiraService
.Open "GET", "https://**MyJiraLink**/secure/attachment/123455/Test.xlsm", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Basic " & EncodeBase64(JiraUID & ":" & JiraPWD)
.setRequestHeader "Accept", "application/json"
.send
sStatus = .status & " | " & .statusText
If .status = "401" Then
MsgBox "Not Connected"
End If
FileData = .responseBody
FileNum = FreeFile
Open sPath For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
End With
Set oJiraService = Nothing
End Sub
Private Function EncodeBase64(srcTxt As String) As String
Dim arrData() As Byte
arrData = StrConv(srcTxt, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument60
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument60
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
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":[]}
How to GET response using VBA?
This code here does not work. In Debug.Pring() or MsgBox is empty.
TargetURL = snURL + selectedMail
Set HTTPReq = CreateObject("WinHttp.WinHttpRequest.5.1")
HTTPReq.Open "GET", TargetURL, False
HTTPReq.SetCredentials snUser, snPass, 0
HTTPReq.setRequestHeader "Accept", "application/json"
Debug.Print HTTPReq.responseText
I want to get JSON data.
Optional libraries (needed, if early binding is used, in general the code will work without them):
Change the companyName variable:
Sub TestMe()
Dim xmlObject As Object
Dim companyName As String: companyName = "Google"
Dim strUrl As String
strUrl = "http://dev.markitondemand.com/MODApis/Api/v2/Lookup/json?input=" & companyName
Set xmlObject = CreateObject("MSXML2.XMLHTTP")
With xmlObject
.Open "GET", strUrl, False
.Send
End With
Dim response As String
response = "{""data"":" & xmlObject.ResponseText & "}"
Debug.Print response
End Sub
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.
The following code downloads files from a location. It is working on my Machine but not on server. I am getting:
Runtime Error 3001: 'Arguments are of the wrong type or out of acceptable range…'at '.write xHttp.responseBody
The below is the Code Snippet:
For i = 2 To row_cnt
Value1 = xlSheet.Cells(i, 1).Value
Value2 = xlSheet.Cells(i, 2).Value
'MsgBox "value of i--> " & i
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
xHttp.Open "GET", Value1, False, "username", "password"
xHttp.Send
With bStrm
.Type = 1 '//binary
.Open
.write xHttp.responseBody
.savetofile Value2, 2 '//overwrite
End With