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

【问题标题】：Getting a list of Excel files in a folder on OneDrive using VBA使用 VBA 获取 OneDrive 上文件夹中的 Excel 文件列表
【发布时间】：2021-06-09 21:57:24
【问题描述】：

在 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: 路径，因为这个想法是用户将文件放在共享文件夹中并在他们的末端运行宏（即我的本地路径可能与他们的本地路径不同）。

谢谢！

【问题讨论】：

见：stackoverflow.com/questions/1344910/…

标签： vba onedrive

【解决方案1】：

从上面的链接引用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

【讨论】：

谢谢，但不幸的是我仍然遇到同样的错误。我可以在浏览器上看到内容，但是当我将 URL 复制到代码中时，仍然出现 Path Not Found 错误。
我认为这可能适用于 SharePoint，但可能不适用于 OneDrive...

【解决方案2】：

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

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

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

 `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

【讨论】：