Create folder and subfolder

Question

I have an Excel file with hundreds of Customer names and several article numbers.

I want to check if a folder with selected customer name exists and create a folder if it is missing.
Once the customer folder is found or created, check if there is a folder for each article number and if it is missing, create one.

I found code that seems to do all that and more posted by Scott Holtzman.

I have referenced Microsoft Scripting Runtime as the code requests.
Both of the "If not" statements are marked red and the pop-up window only says "Compile error".

I checked the syntax of "If not" statements and it seems to be correct.

'requires reference to Microsoft Scripting Runtime
Sub MakeFolder()
    
    Dim strComp As String, strPart As String, strPath As String
    
    strComp = Range("A1") ' assumes company name in A1
    strPart = CleanName(Range("C1")) ' assumes part in C1
    strPath = "C:\Images\"
    
    If Not FolderExists(strPath & strComp) Then 
        'company doesn't exist, so create full path
        FolderCreate strPath & strComp & "\" & strPart
    Else
        'company does exist, but does part folder
        If Not FolderExists(strPath & strComp & "\" & strPart) Then
            FolderCreate strPath & strComp & "\" & strPart
        End If
    End If
    
End Sub
    
Function FolderCreate(ByVal path As String) As Boolean
    
    FolderCreate = True
    Dim fso As New FileSystemObject
    
    If Functions.FolderExists(path) Then
        Exit Function
    Else
        On Error GoTo DeadInTheWater
        fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
        Exit Function
    End If
    
DeadInTheWater:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function
    
End Function
    
Function FolderExists(ByVal path As String) As Boolean
    
    FolderExists = False
    Dim fso As New FileSystemObject
    
    If fso.FolderExists(path) Then FolderExists = True
    
End Function
    
Function CleanName(strName as String) as String
    'will clean part # name so it can be made into valid folder name
    'may need to add more lines to get rid of other characters
    
    CleanName = Replace(strName, "/","")
    CleanName = Replace(CleanName, "*","")
    '    etc...
    
End Function

strComp is a VBA function, renaming your variables will be the solution — Storax
– Storax, Commented Jan 20, 2019 at 17:55
@Storax Actually, you can use variable StrComp without any limitations after you override intrinsic function by declaring Dim StrComp. Compiler even stops to highlight it as a reserved word. — omegastripes
– omegastripes, Commented Jan 21, 2019 at 12:52

omegastripes · Accepted Answer · 2019-01-21 10:42:18Z

Take a look at the below example, it shows one of the possible approaches using recursive sub call:

Option Explicit

Sub TestArrays()

    Dim aCustomers
    Dim aArticles
    Dim sCustomer
    Dim sArticle
    Dim sPath

    sPath = "C:\Test"
    aCustomers = Array("Customer01", "Customer02", "Customer03", "Customer04", "Customer05")
    aArticles = Array("Article01", "Article02", "Article03", "Article04", "Article05")
    For Each sCustomer In aCustomers
        For Each sArticle In aArticles
            SmartCreateFolder sPath & "\" & sCustomer & "\" & sArticle
        Next
    Next

End Sub

Sub TestFromSheet()

    Dim aCustomers
    Dim aArticles
    Dim i
    Dim j
    Dim sPath

    sPath = "C:\Test"
    With ThisWorkbook.Sheets(1)
        aCustomers = .Range(.Range("A1"), .Range("A1").End(xlDown)).Value
        aArticles = .Range("B1:B10").Value
    End With
    For i = LBound(aCustomers, 1) To UBound(aCustomers, 1)
        For j = LBound(aArticles, 1) To UBound(aArticles, 1)
            SmartCreateFolder sPath & "\" & aCustomers(i, 1) & "\" & aArticles(j, 1)
        Next
    Next

End Sub

Sub SmartCreateFolder(sFolder)

    Static oFSO As Object

    If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")
    With oFSO
        If Not .FolderExists(sFolder) Then
            SmartCreateFolder .GetParentFolderName(sFolder)
            .CreateFolder sFolder
        End If
    End With

End Sub

Sub TestArrays() checks and creates folders for customers and articles from the hardcoded arrays, and Sub TestFromSheet() gets customers and articles from the first worksheet, as an example customers range from A1 up to the last element, so it should be more than one element there, and articles set to fixed range B1:B10, like shown below:

How can I adjust the aCustomer array part if I only have 1 customer active at a moment? Currently it needs at least 2 customers.
I have a Cell that the customer name is in (B7), Array doesn't want to accept only one value.
@HenryR I've updated the answer with the example of how to get source data from the worksheet.

VBasic2008 · Accepted Answer · 2019-01-20 17:56:06Z

1

The StrComp Issue

You cannot use StrComp, its a reserved word, actually a string function. I lost about 15 minutes the other day on this issue.

VBA says: Returns a Variant (Integer) indicating the result of a string comparison.

answered Jan 20, 2019 at 17:56

VBasic2008

56.8k5 gold badges21 silver badges38 bronze badges

3 Comments

omegastripes Over a year ago

Actually, you can use variable StrComp without any limitations after you override intrinsic function by declaring Dim StrComp. Compiler even stops to highlight it as a reserved word.

VBasic2008 Over a year ago

@omegastripes: I don't understand what you're saying. Could you elaborate on this or provide a link. BTW when I use 'Sub StrCompIssue() Dim StrComp StrComp = "The StrComp Issue" Debug.Print StrComp End Sub' with or without Option Explicit it raises 'Compile error: Syntax error'.

omegastripes Over a year ago

I must admit that I miss something while testing, thus after declaration Dim StrComp it's possible to assign a value to the variable, but there is still no possible way to use that variable. That's why +1 )

user10931127 · Accepted Answer · 2019-01-20 18:00:58Z

If you want to shorthand a bunch of that code, use MKDIR to create each level of folder\subfolder with error pass-over.

Option Explicit

Sub main()

    Dim pth As String

    pth = "c:\test\abc\123\test_again\XYZ\01-20-2019"

    'folder may or may not exist

    makeFolder pth

    'folder definitely exists

End Sub

Sub makeFolder(fldr As String)

    Dim i As Long, arr As Variant

    'folder may or may not exist

    arr = Split(fldr, Chr(92))
    fldr = arr(LBound(arr))

    On Error Resume Next
    For i = LBound(arr) + 1 To UBound(arr)
        fldr = Join(Array(fldr, arr(i)), Chr(92))
        MkDir fldr
    Next i
    On Error GoTo 0

    'folder definitely exists

End Sub

Jeremy Caney · Accepted Answer · 2020-07-05 02:54:38Z

0

To rename an existing file to a new location WITH creation of all subdirectories, you can use:

File_Name_OLD = File_Pad_OLD & "Test.txt"
File_Pad_NEW = "e:\temp\test1\test2\test3\"
File_Name_NEW = File_Pad_NEW & "Test.txt"

X = File_Pad_NEW
A = 1
Do Until A = 0
A = InStr(X, "\")
Y = Y & Left(X, A)
X = Mid(X, A + 1)
If Dir(Y, 16) = "" Then MkDir Y
Loop
Name File_Name_OLD As File_Name_NEW

This is creating the new path with subdirectories and renames the old file to the new one.

edited Jul 5, 2020 at 2:54

Jeremy Caney

7,798113 gold badges57 silver badges86 bronze badges

answered Jul 5, 2020 at 0:43

JdC

132 bronze badges

Collectives™ on Stack Overflow

Create folder and subfolder

4 Answers 4

11 Comments

The StrComp Issue

3 Comments

Comments

Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

11 Comments

The StrComp Issue

3 Comments

Comments

Comments

Linked

Related