Create a folder and sub folder in Excel VBA

Another simple version working on PC:

Sub CreateDir(strPath As String)    Dim elm As Variant    Dim strCheckPath As String    strCheckPath = ""    For Each elm In Split(strPath, "\")        strCheckPath = strCheckPath & elm & "\"        If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath    NextEnd Sub

One sub and two functions. The sub builds your path and use the functions to check if the path exists and create if not. If the full path exists already, it will just pass on by.This will work on PC, but you will have to check what needs to be modified to work on Mac as well.

'requires reference to Microsoft Scripting RuntimeSub MakeFolder()Dim strComp As String, strPart As String, strPath As StringstrComp = Range("A1") ' assumes company name in A1strPart = CleanName(Range("C1")) ' assumes part in C1strPath = "C:\Images\"If Not FolderExists(strPath & strComp) Then 'company doesn't exist, so create full path    FolderCreate strPath & strComp & "\" & strPartElse'company does exist, but does part folder    If Not FolderExists(strPath & strComp & "\" & strPart) Then        FolderCreate strPath & strComp & "\" & strPart    End IfEnd IfEnd SubFunction FolderCreate(ByVal path As String) As BooleanFolderCreate = TrueDim fso As New FileSystemObjectIf Functions.FolderExists(path) Then    Exit FunctionElse    On Error GoTo DeadInTheWater    fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?    Exit FunctionEnd IfDeadInTheWater:    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."    FolderCreate = False    Exit FunctionEnd FunctionFunction FolderExists(ByVal path As String) As BooleanFolderExists = FalseDim fso As New FileSystemObjectIf fso.FolderExists(path) Then FolderExists = TrueEnd FunctionFunction 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

I found a much better way of doing the same, less code, much more efficient. Note that the """" is to quote the path in case it contains blanks in a folder name. Command line mkdir creates any intermediary folder if necessary to make the whole path exist.

If Dir(YourPath, vbDirectory) = "" Then    Shell ("cmd /c mkdir """ & YourPath & """")End If