0

The file path doesn't work when:

Path = Sheets("Sheet1").Range("C2").Value & "\"

The file path in C2 doesn't include \ at the end

Sub Make_Folders_And_SubFolders()

Dim GPath, GName, UName, UGroup As String
Dim UserID, Groups, G, U As Range
Dim Gcounter, Ucounter As Integer

GPath = Sheets("Sheet1").Range("C2").Value & "\"

On Error GoTo Finish
If Len(GPath) = 0 Or Right(GPath, 1) <> "\" Then
Finish:
    MsgBox "Please, check if:" & vbNewLine _
    & "1- Folder Path is empty." & vbNewLine _
    & "2- or "" \ "" is missing at the end of the path." & vbNewLine _
    & "3- or Path does not exist.", vbCritical
    Exit Sub
End If

Set Groups = Sheets("Sheet1").Range(Cells(5, "P"), Cells(Rows.Count, "P").End(xlUp))
Set UserID = Sheets("Sheet1").Range(Cells(5, "Q"), Cells(Rows.Count, "Q").End(xlUp))

For Each G In Groups
    GName = Trim(G.Value) & "_Group"
    If Len(Dir(GPath & GName, vbDirectory)) > 0 Then
        GoTo Nxt1
    Else
        MkDir GPath & GName
        Gcounter = Gcounter + 1
    End If

Nxt1:
Next G

For Each U In UserID
    UName = Trim(U.Value)
    UGroup = Trim(U.Offset(0, 1).Value) & "_Group"
    If Len(Dir(GPath & UGroup & "\" & UName, vbDirectory)) > 0 Then
        GoTo Nxt2
    Else
        MkDir GPath & UGroup & "\" & UName
        Ucounter = Ucounter + 1
    End If

Nxt2:

Next U

If Gcounter + Ucounter = 0 Then
    MsgBox "All Folders exist, " & vbNewLine & "No folder to be created"
Else
    MsgBox "Job Done !!" & vbNewLine _
      & "Group Folders created: = " & Gcounter & vbNewLine _
      & "User ID Folders created: = " & Ucounter, _
      Title:="Foders Created Count"
End If
End Sub
Community
  • 1
  • 1

2 Answers2

0

May I suggest for file operations and path building use a FileSystemObject. It absolutely negates the need to have \ on the end of paths, as it is smart enough to add it when needed. Specifically, the fso.BuildPath() method was designed to suit this exact need.

Public Sub CombinePathTest()

    Dim path As String, fn As String
    
    path = fso.GetParentFolderName(Sheets("Sheet1").Range("C2").Value)
    
    fn = fso.BuildPath(path, Uname)

End Sub

From the documentation, you can see there are a lot of helpful functions that take the stress out of building paths, opening files, creating or deleting, or check for existence.

fig

and by defining as a reference, and adding a global fso object you have access to Intellisense while writing code

fig2

John Alexiou
  • 28,472
  • 11
  • 77
  • 133
-1

Try the following. Note that I haven't touched anything from For Each G In Groups to the end.

Sub FileOperation()
    
    Dim GPath As String, GName As String, UName As String, UGroup As String
    Dim UserID As Range, Groups As Range, G As Range, U As Range
    Dim Gcounter As Long, Ucounter As Long
    Dim pSep As String: pSep = Application.PathSeparator
    Dim wb As Workbook: Set wb = ThisWorkbook
        
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    GPath = ws.Range("C2").Value

    If Len(GPath) = 0 Then
        MsgBox "Path is empty.", vbCritical
        Exit Sub
    End If
    If Right(GPath, 1) <> pSep Then
        GPath = GPath & pSep
    End If
    
    Set Groups = ws.Range(ws.Cells(5, "P"), ws.Cells(Rows.Count, "P").End(xlUp))
    Set UserID = ws.Range(ws.Cells(5, "Q"), ws.Cells(Rows.Count, "Q").End(xlUp))
    
    For Each G In Groups
            GName = Trim(G.Value) & "_Group"
            If Len(Dir(GPath & GName, vbDirectory)) > 0 Then
                    GoTo Nxt1
            Else
                    MkDir GPath & GName
                    Gcounter = Gcounter + 1
            End If
    
Nxt1:
    Next G
    
    For Each U In UserID
            UName = Trim(U.Value)
            UGroup = Trim(U.Offset(0, 1).Value) & "_Group"
            If Len(Dir(GPath & UGroup & "\" & UName, vbDirectory)) > 0 Then
                    GoTo Nxt2
            Else
                    MkDir GPath & UGroup & "\" & UName
                    Ucounter = Ucounter + 1
            End If
    
Nxt2:
    
    Next U
    
    If Gcounter + Ucounter = 0 Then
            MsgBox "All Folders exist, " & vbNewLine & "No folder to be created"
    Else
            MsgBox "Job Done !!" & vbNewLine _
            & "Group Folders created: = " & Gcounter & vbNewLine _
            & "User ID Folders created: = " & Ucounter, _
            Title:="Foders Created Count"
    End If

End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28