How to download multiple files from same link in Sharepoint - vba

Question

I have the following code to download a single file from a share point site:
Private 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 Long
Dim Ret As Long
Sub Report_download()
Dim strURL As String
Dim strPath As String
Dim strFile As String
strFile = "report.Denial." & Format(sDate, "yyyymmdd") & ".xlsx"
strURL = "https://sharepoint.com/HumanResources/Shared%20Documents/report.Denial.xlsx"
strPath = sPATH & strFile
Ret = URLDownloadToFile(0, strURL, strPath, 0, 0)
If Ret = 0 Then
' MsgBox "File successfully downloaded"
Else
MsgBox "Returncode:" & Ret & " Unable to download"
End If
End Sub
My question is this. I have 3 files to download from the same site. Links are the same, except of course, the report name. Is there a way that this code can be rewritten as loop to download the 3 files I need from this URL?
thank you

Answer 1

This should do what you want.
Option Explicit
Sub btnSharePointFolder()
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("SharePoint Download")
If sht.Range("SharePointPath") = "" Then
MsgBox "Please enter a sharepoint path first", vbCritical
Exit Sub
End If
If Right(sht.Range("SharePointPath"), 1) <> "/" Then
'SharePointPath: http://testdrive.sharepoint.ckannan.blogspot.com/teams/YourTeam/
sht.Range("SharePointPath") = sht.Range("SharePointPath") & "/"
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sht.Range("SharePointPath")
.Title = "Please select a location of input files"
.Show
If Not .SelectedItems.Count = 0 Then
sht.Range("SharepointFolder") = .SelectedItems(1)
Else
Exit Sub
End If
End With
' 'To Remove Drive
' Shell "net use Q: /delete"
If Dir("Q:\", vbDirectory) = "" Then
Shell "net use Q: " & sht.Range("SharePointPath").Value '/user:MyDomain\MyUserName MyPassword
End If
End Sub
'_________________________________________________________________________________
Sub MapNetworkDrive()
If Dir("Q:\", vbDirectory) = "" Then
'SharePointPath: http://testdrive.sharepoint.ckannan.blogspot.com/teams/YourTeam/
Shell "net use Q: " & ThisWorkbook.Sheets("SharePoint Download").Range("SharePointPath").Value '/user:MyDomain\MyUserName MyPassword
MsgBox "The sharepoint path is mapped as network drive.", vbInformation
Else
MsgBox "The mapped network drive already exists.", vbInformation
End If
End Sub
'_________________________________________________________________________________
Sub DownloadFiles()
Dim Directory As String
Dim file As String
Dim i As Long
Dim fso As FileSystemObject
Application.ScreenUpdating = False
If Dir("Q:\", vbDirectory) = "" Then
MsgBox "There is no mapped network drive", vbCritical
Exit Sub
End If
'DownloadFolder: http://testdrive.sharepoint.ckannan.blogspot.com/teams/YourTeam/Shared Documents/PDW Status
Directory = "Q:\" & ThisWorkbook.Sheets("SharePoint Download").Range("DownloadFolder").Value & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
' Get first file
file = Dir(Directory, vbReadOnly + vbHidden + vbSystem)
If file = "" Then
MsgBox "No files found in the sharepoint folder.", vbCritical
Exit Sub
End If
Do While file <> ""
fso.CopyFile Directory & file, "C:\", True
file = Dir()
Loop
Application.StatusBar = False
MsgBox "Downloaded all files to the local folder.", vbInformation
End Sub
'_________________________________________________________________________________
Sub btnLocalFolder_Click()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Please select a location to download files"
.Show
If Not .SelectedItems.Count = 0 Then
ThisWorkbook.Sheets("SharePoint Download").Range("LocalFolder") = .SelectedItems(1)
End If
End With
End Sub