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

Question

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

我认为问题在于Application.ActiveWorkbook.Path 提供的是链接而不是路径。

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

下面的图片是我试图打开文件的地方

Sub getfolders()

    Dim objFSO As New FileSystemObject
    Dim objFolder As Object
    Dim objSubFolder As Object
        
    Dim i As Integer
    Dim FldName As String
      
    Set objFolder = objFSO.GetFolder(Application.ActiveWorkbook.Path)
    
    Lastrow = Cells(Rows.Count, "B").End(xlUp).Row ' guarda o indice da ultima linha com conteudo da coluna B. Mesmo havendo vazios identifca a ultima linha
    Length = Range(Range("B8"), Range("B" & Lastrow)).Rows.Count ' dimensão da coluna C ate a ultima celula com conteudo começando na C7


For i = 0 To Length ' loop na coluna B

    For Each objSubFolder In objFolder.SubFolders

(rest of the code...)

Answer 1

以下代码获取用户 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

Answer 2

循环遍历 OneDrive 文件夹

• 调整常量部分中的值。
• 完成测试后，您可以删除或取消注释 Debug.Print 行。

功能 (Microsoft Docs)

• Environ function
• Split function（使用Limit）
• FileSystemObject object
• Folder object

守则

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