VBA - Bouclez les dossiers sur Onedrive

Question

J'ai le code ci-dessous qui parcourt les dossiers sur le chemin où le fichier Excel est sauvegardé et applique un ensemble de paramètres. Le code fonctionne parfaitement sur un dossier local de mon disque. Cependant, sur un dossier local sauvegardé sur Onedrive, il ne fonctionne pas et fournit le message suivant erreur 76 "Chemin non trouvé" .

Je pense que le problème se situe au niveau de la Application.ActiveWorkbook.Path qui délivre un lien et non un chemin.

Quelqu'un a-t-il une suggestion pour résoudre ce problème ? Je vous remercie.

L'image ci-dessous montre l'endroit où j'essaie d'ouvrir le fichier.

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

Le code suivant permet d'obtenir les noms des sous-dossiers du répertoire OneDrive de l'utilisateur. Modifiez-le en fonction de vos besoins.

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

Boucle dans les dossiers OneDrive

• Ajustez les valeurs dans la section des constantes.
• Une fois les tests terminés, vous pouvez supprimer ou compléter les éléments suivants Debug.Print lignes.

Caractéristiques (Microsoft Docs)

• Environ function
• Split function (en utilisant Limit )
• FileSystemObject object
• Folder object

Le code

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