Copying (downloading) a file knowing its URL (With VBA).

[Bastringue]

Hello,
I would like to copy (download) a File located on a URL. This URL is located on a OneDrive Cloud space (maybe it plays a part).
I have checked that I have a R/W authorization on this file, granted by the owner of the Drive.
Moreover, this file is an Excel Workbook that I can open and load in my Internet browser (works fine).

Now I would like to copy it by a VBA code. I have used code we can easily find in many places, given below.
Unfortunately, it does not work for me.

By any chance, would you know how to copy an Excel Workbook from a OneDrive location to a local directory ? ...Thanks in advance

Option Explicit
 
Declare PtrSafe Function URLDownloadToFile _
    Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As LongPtr
 
Private Const ERROR_SUCCESS As Long = 0
 
Public Function DownloadFile(ByVal sURL As String, ByVal sLocalFile As String) As Boolean
    Dim lngRetVal As LongPtr
    DownloadFile = URLDownloadToFile(0&, sURL, sLocalFile, 0&, 0&) = ERROR_SUCCESS
End Function

Option Explicit
 
Declare PtrSafe Function URLDownloadToFile _
    Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As LongPtr
 
Private Const ERROR_SUCCESS As Long = 0

Public Function DownloadFile(ByVal sURL As String, ByVal sLocalFile As String) As Boolean 
    Dim lngRetVal As LongPtr
    DownloadFile = URLDownloadToFile(0&, sURL, sLocalFile, 0&, 0&) = ERROR_SUCCESS
End Function

Sub go()
    DownloadFile "https://d.docs.live.net/181eeee77f46f4563/Documents/file.xlsm", "C:\file.xlsm"
End Sub

[Aussiebear]

maybe try a version of this?

Sub open_excel_from_one_drive()
sfilename = "https://d.docs.live.net/18leeee77f46f4563/Documents/file.xlsm" '<----- Change to suit your file name
Set xl = CreateObject("Excel.Sheet")
Set xlsheet = xl.Application.Workbooks.Open(Filename:=sfilename, ReadOnly:=True)
End Sub

[Aussiebear]

this is another version that I found.

Sub DownloadFile()
'Declare the Object and URL
Dim myURL As String
Dim WinHttpReq As Object
'Assign the URL and Object to Variables
myURL = "https://d.docs.live.net/18leeee77/f46/4563/Documents/file.xlsm"
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 "C:\testdownload.xlsx", 2
    oStream.Close
End If
End Sub

[Bastringue]

Thank you for these ideas... actually I think your first idea was the good one for me. I have slightly modified it to obtain this routine that works well...
I did not try the second one but I am afraid it downloads the html content of the URL we would have if we opened the file in a browser and not the file itself...(I am not sure).
thanks again...

Function DownloadFile(URL As String, LocalPath As String) As Boolean
    Dim result As Long
    Dim newWB As Workbook
    Dim xl As Application
    
    Set xl = CreateObject("Excel.Application")
    xl.DisplayAlerts = False
    
    Set newWB = Workbooks.Open(filename:=URL, ReadOnly:=True)
    
    On Error Resume Next ' Resume error handling
    newWB.SaveAs filename:=LocalPath
    
    ' Check if an error occurred during the workbook saving
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation
        Err.Clear
        DownloadFile = False
    Else
        MsgBox "Workbook saved successfully!", vbInformation
        DownloadFile = True
    End If
    
    newWB.Close
    set xl = Nothing
    set newWB = Nothing
    On Error GoTo 0
    
End Function

[Bastringue]

Hi, I come back because there is an issue I can't solve. The Copy made here keeps me from seeing the sheets inside
Actually, when I open the new file (by hand), the sheets don't show even though they exist (I see them in the VBA part and their visibility parameter is True).
It looks like I don't close the file correctly after having created it... My last code is here.... hoping someone has already experienced this.

Function DownloadFile(URL As String, LocalPath As String) As Boolean
    Dim result As Long
    Dim newWB As Workbook
    Dim xl As Application
    
    Set xl = CreateObject("Excel.Application")
    xl.DisplayAlerts = False
    
    Set newWB = Workbooks.Open(filename:=URL, ReadOnly:=True)
    
    On Error Resume Next 
    newWB.SaveAs filename:=LocalPath
    
    ' Check if an error occurred during the workbook saving
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation
        Err.Clear
        DownloadFile = False
    Else
        MsgBox "Workbook saved successfully!", vbInformation
        DownloadFile = True
        DoEvents
        newWB.Close SaveChanges:=False
       Application.Wait Now + TimeValue("00:00:01")
    End If
     On Error GoTo 0
   
   ThisWorkBook.Activate   
    set xl = Nothing
    set newWB = Nothing
    
End Function

[Bastringue]

Hi, I come back because there is a small issue I can't solve. The Copy made here keeps me from seeing the sheets inside
Actually, when I open the new file (by hand), the sheets don't show even though they exist (I see them in the VBA part and their visibility parameter is True).
As explained here, by hand we must go to '"Affichage" (View ?) and click on "UnHide" and this makes the sheets appear (fine).
Ideally, I would like to toggle this property "On" before I close the file in my code. I have tried something like "newDB.Windows(1).Visible = True " but it didn't work...
Hoping someone has already experienced this.

Function DownloadFile(URL As String, LocalPath As String) As Boolean
    Dim result As Long
    Dim newWB As Workbook
    Dim xl As Application
    
    Set xl = CreateObject("Excel.Application")
    xl.DisplayAlerts = False
    
    Set newWB = Workbooks.Open(filename:=URL, ReadOnly:=True)
    
    On Error Resume Next 
    newWB.SaveAs filename:=LocalPath
    
    ' Check if an error occurred during the workbook saving
    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation
        Err.Clear
        DownloadFile = False
    Else
        MsgBox "Workbook saved successfully!", vbInformation
        DownloadFile = True
        DoEvents
        newWB.Windows(1).Visible = True
        newWB.Close SaveChanges:=True
    End If
     On Error GoTo 0
   
   ThisWorkBook.Activate   
    set xl = Nothing
    set newWB = Nothing
    
End Function

[Jan Karel Pieterse]

Your code reads:

newDB.Windows(1).Visible = True

I think that shoule be:

newWB.Windows(1).Visible = True

[Bastringue]

Hello Jan, you have a good sight but I apologize, it is just a typo in the post that I rectify... the problem is still here... thanks anyway for having seen it...

[Dave]

Hi Bastringue. You are close and Aussiebear provided you with some helpful code which is seems you didn't use? Anyways, change the following part of your code and it should work. HTH. Dave

Dim NewWb As Object, xl As Object
Application.DisplayAlerts = False
Set xl = CreateObject("Excel.Sheet")
Set NewWb = xl.Application.Workbooks.Open(fileName:=URL, ReadOnly:=True)
NewWb.SaveCopyAs fileName:=LocalPath
NewWb.Close SaveChanges:=False
Application.DisplayAlerts = True
Set NewWb = Nothing
Set xl = Nothing