使用 VBA 获取 OneDrive 上文件夹中 Excel 个文件的列表

Question

在 Excel 中，我录制了一个宏以在 OneDrive for Business 上打开一个文件，它生成的代码如下所示，可以正常工作：

Workbooks.Open Filename:= "https://mycopmanymy.sharepoint.com/personal/john/Documents/John/Shared/Support/SDM%20Rebates%20v30.xlsm"

问题是要使它工作，程序必须确切地知道文件名。我希望 VBA 会扫描该特定文件夹并打开每个文件，所以我只是删除了文件名并使用了相同的 URL 并使用了以下代码：

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("https://mycopmanymy.sharepoint.com/personal/john/Documents/John/Shared/Support/")
For Each oFile In oFolder.Files
    Debug.print(oFile.Name)
Next

这给了我找不到路径的错误。请注意，我不想使用本地 C: 路径，因为用户会将文件放在共享文件夹中，并将运行宏放在他们的末端（即我的本地路径可能与他们的不同本地路径）。

谢谢！

Answer 1

引用上面 link 中的 SharePointURLtoUNC，你可以试试这个：

Sub TT()
    Dim f As String, oFSO, oFolder, oFile
   
    f = "https://mycopmanymy.sharepoint.com/personal/john/Documents/John/Shared/Support/"
    Debug.Print "URL", f
    f = SharePointURLtoUNC(f)
    Debug.Print "UNC", f
   
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(f)
    
    For Each oFile In oFolder.Files
        Debug.Print oFile.Name
    Next
End Sub

Public Function SharePointURLtoUNC(sURL As String) As String
    Dim bIsSSL As Boolean
    bIsSSL = InStr(1, sURL, "https:") > 0
    sURL = Replace(Replace(sURL, "/", "\"), "%20", " ")
    sURL = Replace(Replace(sURL, "https:", vbNullString), "http:", vbNullString)
    sURL = Replace(sURL, Split(sURL, "\")(2), Split(sURL, "\")(2) & "@SSL\DavWWWRoot")
    If Not bIsSSL Then sURL = Replace(sURL, "@SSL\", vbNullString)
    SharePointURLtoUNC = sURL
End Function

Answer 2

我在这个 link 中找到了解决方案：
https://officeaccelerators.wordpress.com/2015/01/29/vba-code-to-download-list-of-files-and-folders-from-sharepoint/

可能需要稍微调整一下，但它会列出指定共享点文件夹中的所有文件

注意您必须更改这行代码以适合您公司的url：

 `SharepointAddress = "https://abc.onmicrosoft.com/TargetFolder/"`


Sub DownloadListFromSharepoint()
    Dim SharepointAddress As String
    Dim LocalAddress As String
    Dim objFolder As Object
    Dim objNet As Object
    Dim objFile As Object
    Dim FS As Object
    Dim rng As Range
    SharepointAddress = "https://abc.onmicrosoft.com/TargetFolder/"

    Set objNet = CreateObject("WScript.Network")
    Set FS = CreateObject("Scripting.FileSystemObject")
    objNet.MapNetworkDrive "A:", SharepointAddress
    
    Set objFolder = FS.getfolder("A:")
    
    Set rng = ThisWorkbook.Worksheets(1).Range("a1")
    rng.Value = "File Name"
    rng.Offset(0, 1).Value = "Folder/File"
    rng.Offset(0, 2).Value = "Path"
    GetAllFilesFolders rng, objFolder, "" & strSharepointAddress
    objNet.RemoveNetworkDrive "A:"
    Set objNet = Nothing
    Set FS = Nothing

End Sub

Public Sub GetAllFilesFolders(rng As Range, ObjSubFolder As Object, strSharepointAddress As String)
    Dim objFolder As Object
    Dim objFile As Object
    
    For Each objFile In ObjSubFolder.Files
        rng.Offset(1, 0) = objFile.Name
        rng.Offset(1, 1) = "File"
        rng.Offset(1, 2) = Replace(objFile.Path, "A:\", SharepointAddress)
        Set rng = rng.Offset(1, 0)
    Next
    For Each objFolder In ObjSubFolder.subfolders
        rng.Offset(1, 0) = objFolder.Name
        rng.Offset(1, 1) = "Folder"
        rng.Offset(1, 2) = Replace(objFolder.Path, "A:\", SharepointAddress)
        Set rng = rng.Offset(1, 0)
        GetAllFilesFolders rng, objFolder, strSharepointAddress
    Next
End Sub

使用 VBA 获取 OneDrive 上文件夹中 Excel 个文件的列表

Getting a list of Excel files in a folder on OneDrive using VBA

vba

onedrive