CODEWITHSUNDEEP
excelvbaonedrive
user2292821
user2292821

Reputation: 87

VBA - Loop through folders on Onedrive

I´ve the code below that loops through the folders on the path where the excel file is saved and applies a set of parameters. The code works great on a local folder on my drive. However, on a local folder saved on Onedrive it does not work and provides the error 76 "Path not found".

I believe the problem sits with the Application.ActiveWorkbook.Path that delivers a link and not a path.

Does any one have any suggestion on how to solve this problem? Thanks.

Se image below to where i´m trying to open the file enter image description here

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...)

Upvotes: 2

Views: 2415

Answers (2)

VBasic2008
VBasic2008

Reputation: 54807

Loop Through OneDrive Folders

  • Adjust the values in the constants section.
  • When done testing, you can remove or out-comment the Debug.Print lines.

Features (Microsoft Docs)

The 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

Upvotes: 0

Rich Michaels
Rich Michaels

Reputation: 1713

The following code obtains the names of the subfolders within the user’s OneDrive directory. Modify it to met your needs.

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

Upvotes: 2

Related Questions