如何从Sharepoint中的同一链接下载多个文件

Question

我有以下代码从共享点网站下载单个文件：

  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

我的问题是这个。我有3个文件可以从同一个站点下载。链接是相同的，当然除了报告名称。有没有办法可以将此代码重写为循环，以便从此URL下载我需要的3个文件？

谢谢

Answer 1

这应该做你想要的。

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