download a file from onedrive

[vmjan02]

I have this code and is working perfect, it downloads a excel file from onedrive, only problem is once the file is downloaded, it gives an error (ref screen shot), after download, its not opening a downloaded file

any suggestion..

Sub DownloadFile()
'Declare the Object and URL
Dim myURL As String
Dim WinHttpReq As Object
'Assign the URL and Object to Variables
myURL = "https://qtechsoftware-my.sharepoint.com/:x:/p/viral_shah/EQDzOJrS8EFMkvQibRv21IABkWlaehkR8wHYJm3G103-Kw?e=AyJLXT/Daily work sheet1.xlsx"
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")

'Provide Access Token and PWD to the URL for getting the service from API
WinHttpReq.Open "GET", myURL, False, "abcdef", "12345"
WinHttpReq.Send
Debug.Print WinHttpReq.Status
myURL = WinHttpReq.ResponseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
         oStream.Write WinHttpReq.ResponseBody
        oStream.SaveToFile "D:\Daily Work Sheet1.xlsx" ,  2
        oStream.Close
    End If
End Sub

 

[Marc L]

​

Do not use ADODB.Stream but the standard VBA method Open file For Binary with an array variable as Byte for the responseBody …​

 

[vmjan02]

​

Do not use ADODB.Stream but the standard VBA method Open file For Binary with an array variable as Byte for the responseBody …​

well i did tried the same, but no luck, any chance can you help me to modify the code

 

[Marc L]

See the yesterday thread "Download pictures …" about the same subject with all the necessary …​

 

[Fluff]

See the yesterday thread "Download pictures …" about the same subject with all the necessary …

It would be helpful if you could post the actual link. Rather than some vague rubbish.

 

[vmjan02]

​

See the yesterday thread "Download pictures …" about the same subject with all the necessary …​

you mean this post

Download pictures from URLs en masse

I have a spreadsheet that looks something like this: Item File URL Tree www.fubar.com/tree1.jpg Tree www.fubar.com/tree2.jpg Pig www.fubar.com/pig1.jpg Pig www.fubar.com/pig2.jpg Flower www.fubar.com/flower1.jpg Flower www.fubar.com/flower2.jpg I'd like to download all the...

www.mrexcel.com

Request you to please advice a correct post so that it will be easy to ref.. thanks

 

[vmjan02]

Hi Every One,
I am still not able to find a solution as getting the same error (ref screen shot on my 1st Post). It is downloading the file, but not allowing to open.
Any other idea's

 

[vmjan02]

Got the solution,

This code now works perfect, thank you all for your support.

Sub DownloadFileFromURL()

Sheets("DownloadFiles").Select
With Worksheets("DownloadFiles")
    With .Range("N2:N" & .Range("a" & .Rows.Count).End(xlUp).Row)
          .Formula = "=RIGHT(B2,LEN(B2)-FIND(""?"",B2))"
        '.Formula = "=F2"
        .Value = .Value
        '.NumberFormat = "DD-MM-YYYY"
     End With
End With

With Worksheets("DownloadFiles")
    With .Range("O2:O" & .Range("a" & .Rows.Count).End(xlUp).Row)
          .Formula = "=SUBSTITUTE(B2,N2,""&download=1"")"
        '.Formula = "=F2"
        .Value = .Value
        '.NumberFormat = "DD-MM-YYYY"
     End With
End With


Dim mainFolder As String
    mainFolder = "D:\Viral"
    If Right(mainFolder, 1) <> "\" Then
        mainFolder = mainFolder & "\"
    End If

    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
 
    Dim i As Long
    Dim destinationFolder As String
    Dim url As String
    Dim errorMessage As String
    For i = 2 To lastRow
        destinationFolder = Cells(i, "A").Value
        url = Cells(i, "O").Value

    Dim objXmlHttpReq As Object
    Dim objStream As Object

Set objXmlHttpReq = CreateObject("Microsoft.XMLHTTP")
     objXmlHttpReq.Open "GET", url, False, "username", "password"
     objXmlHttpReq.send
     If objXmlHttpReq.Status = 200 Then
          Set objStream = CreateObject("ADODB.Stream")
          objStream.Open
          objStream.Type = 1
          objStream.Write objXmlHttpReq.responsebody
          objStream.SaveToFile ThisWorkbook.Path & "\" & "test1.xlsx", 2
          objStream.Close
     End If

Next i
End Sub