Excel VBA-循环浏览Onedrive上的文件夹

下面的代码在excel文件保存路径上的文件夹中循环，并应用一组参数。这段代码在我的驱动器上的本地文件夹上非常有效。但是，在Onedrive上保存的本地文件夹上，它不起作用，并提供错误76“未找到路径”

我认为问题出在

应用程序.ActiveWorkbook.Path

上，它提供的是链接而不是路径

有人对如何解决这个问题有什么建议吗？谢谢

下面的Se图像显示我试图打开文件的位置

---

以下代码获取用户OneDrive目录中的子文件夹的名称。修改它以满足您的需要

Sub ShowOneDriveFolderList()
    Dim fs As Object, f As Object, f1 As Variant, s As String, sf As Variant
    Dim sep As String: sep = Application.PathSeparator
    Dim userHome As String: userHome = Environ("UserProfile") & sep
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(userHome & "OneDrive")
    Set sf = f.subFolders
    For Each f1 In sf
        s = s & f1.Name
        s = s & vbCrLf
    Next
    MsgBox s
End Sub

循环浏览OneDrive文件夹

• 调整常量部分中的值
• 测试完成后，您可以删除或注释

  Debug.Print

  行

功能（Microsoft文档）

• （使用

  限制

  ）

代码

Option Explicit

Sub getFoldersTest()

    ' Define constants.
    Const wsName As String = "Sheet1"
    Const FirstRow As Long = 8
    Const Col As String = "B"
    
    ' Define workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    Debug.Print "Workbook Path: " & wb.Path
    
    ' Define FolderPath (OneDrive-specific).
    Dim Path1 As String: Path1 = Environ("OneDrive")
    Debug.Print "Path1:         " & Path1
    Dim SubStrings() As String: SubStrings = Split(wb.Path, "/", 5)
    Dim Path2 As String: Path2 = Replace(SubStrings(4), "/", "\")
    Debug.Print "Path2:         " & Path2
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim FolderPath As String: FolderPath = fso.BuildPath(Path1, Path2)
    Debug.Print "Folder Path:   " & FolderPath
    
    ' Validate FolderPath.
    If Not fso.FolderExists(FolderPath) Then
        MsgBox "The folder '" & FolderPath & "' does not exist.", vbCritical
        Exit Sub
    End If
    
    ' Calculate Last Row and Length.
    Dim LastRow As Long
    Dim Length As Long
    With wb.Worksheets(wsName) ' or 'wb.ActiveSheet' - not recommended.
        ' Guarda o indice da ultima linha com conteudo da coluna B.
        ' Mesmo havendo vazios identifca a ultima linha.
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row
        Debug.Print "Last Row:      " & LastRow
        ' Dimensao da coluna C ate a ultima celula com conteudo começando na C7.
        Length = LastRow - FirstRow + 1
        Debug.Print "Length:        " & Length
    End With
    
    ' Declare additional variables.
    Dim fsoFolder As Object
    Dim i As Long
    
    ' Loop...
    For i = 0 To Length ' Loop na coluna B.
        For Each fsoFolder In fso.GetFolder(FolderPath).SubFolders
            ' e.g.
            Debug.Print i, fsoFolder.Name, fsoFolder.Path
        Next fsoFolder
    Next i

End Sub

---

只有从online OneDrive打开文件，然后从那里在本地计算机上打开时，才会返回这种路径。在这种情况下，返回的路径也是正确的，但以您尝试的方式在文件夹项之间进行迭代是没有用的。如果您直接从本地文件夹打开它，您将收到一条普通路径，并且可以执行您的请求。您好，谢谢您的回复。我不会在网上打开它。它是从正在同步的onedive上的文件夹打开的。我已经在Clarity的主要帖子上添加了一个图片，恐怕你没有。。。否则，您应该获取本地OneDrive文件夹的路径。你是怎么做到的？请看我在主帖子上添加的图片：）我打开文件并运行宏的地方。

Option Explicit

Sub getFoldersTest()

    ' Define constants.
    Const wsName As String = "Sheet1"
    Const FirstRow As Long = 8
    Const Col As String = "B"
    
    ' Define workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    Debug.Print "Workbook Path: " & wb.Path
    
    ' Define FolderPath (OneDrive-specific).
    Dim Path1 As String: Path1 = Environ("OneDrive")
    Debug.Print "Path1:         " & Path1
    Dim SubStrings() As String: SubStrings = Split(wb.Path, "/", 5)
    Dim Path2 As String: Path2 = Replace(SubStrings(4), "/", "\")
    Debug.Print "Path2:         " & Path2
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim FolderPath As String: FolderPath = fso.BuildPath(Path1, Path2)
    Debug.Print "Folder Path:   " & FolderPath
    
    ' Validate FolderPath.
    If Not fso.FolderExists(FolderPath) Then
        MsgBox "The folder '" & FolderPath & "' does not exist.", vbCritical
        Exit Sub
    End If
    
    ' Calculate Last Row and Length.
    Dim LastRow As Long
    Dim Length As Long
    With wb.Worksheets(wsName) ' or 'wb.ActiveSheet' - not recommended.
        ' Guarda o indice da ultima linha com conteudo da coluna B.
        ' Mesmo havendo vazios identifca a ultima linha.
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row
        Debug.Print "Last Row:      " & LastRow
        ' Dimensao da coluna C ate a ultima celula com conteudo começando na C7.
        Length = LastRow - FirstRow + 1
        Debug.Print "Length:        " & Length
    End With
    
    ' Declare additional variables.
    Dim fsoFolder As Object
    Dim i As Long
    
    ' Loop...
    For i = 0 To Length ' Loop na coluna B.
        For Each fsoFolder In fso.GetFolder(FolderPath).SubFolders
            ' e.g.
            Debug.Print i, fsoFolder.Name, fsoFolder.Path
        Next fsoFolder
    Next i

End Sub