Create a folder and sub folder in Excel VBA

Question

I have a pull down menu of companies that is populated by a list on another sheet. Three columns, Company, Job #, and Part Number.

When a job is created I need a folder for said company and a sub-folder for said Part Number.

If you go down the path it would look like:

C:\Images\Company Name\Part Number\

If either company name or Part number exists don't create, or overwrite the old one. Just go to next step. So if both folders exist nothing happens, if one or both don't exist create as required.

Another question is there a way to make it so it works on Macs and PCs the same?

End

possible duplicate of EXCEL: Create folder hierarchy from spreadsheet data? – Ziguard

Except that it needs to take two columns out of the three to make work... the one you linked to although would work, takes all data not specific data.. – End

@Ziguard link works great, except you need to modify the code (logic) a bit. Using psuedo-code (english as code) -> If Exists C:\Images[Company] then If Exists C:\Images[Company][Part] Then Exit Else Create C:\Images[Company][Part] Else Create C:\Images[Company][Part]. You can use Folder method of FileSystemObject to see if your directory exists and use variables to set the company and part based on cell values. – Hinze

The problem I have with the code is it removes error-checking... I need to know if there is an error. There are a few other issues as well, like generic Mac/PC compliance as far as I can tell. I'm sorry but out of what I can tell with the script linked to is not how I want to proceed. – End

I suggest building in stages. You have what I just gave you -> which has some "built-in error checking" and the other code as well. You can then set that up to work on the PC adding any other error-checking you want (hard to do error-checking without knowing the possibilities -> though I could think of a few). After you having it working PC wise, you can find out what would be different in a mac and tweak the code to adjust for that. – Hinze

I would build in stages if I understood where to start. – End

Upload a snapshot of how data looks and then we will take it from there :) – Hypercritical

@MattRidge I was trying to give you a place to start with the psuedo code... alas, I've placed an answer below. – Hinze

Sure, here. dl.dropbox.com/u/3327208/Excel/test.xlsx This I need to take the Columns C and D. C is company, D is the part. The path in this case is on my PC is C:/images/ on my Mac it is /Images/ So basically it is going to be on the root of both, but I want to make it so that it can be changed if possible, and not assumed where it is going to be. But if it moves it moves on both. I hope this helps. – End

@Scott Thanks, I know what you were attempting but I have learned what I know by examples that are complete not half way done. I have no official training in VBA... so giving me a problem with 1/2 the work done confuses me at times. – End

gotcha - but show attempts goes a long way on this board. Of course, we (if I can speak for everyone?) are happy to help. You mentioned this statement, so that's why I wasn't writing out code for you: "If someone can help me with understanding how this works and how to make it work it would be greatly appreciated" – Hinze

Right but you showed me a link without telling me how it would work with what I have in mind... that's all. That is why I sounded frustrated... sorry bout that. – End

That is why I sounded frustrated. posting an answer which would give you the proper nudge. Gimme few minutes. – Hypercritical

Thanks, and to answer a question would be this: To make the path universal between a Mac and PC use Application.PathSeparator. That should help. I remember that from a script I had a few people help me with to make an external log using Excel VBA. – End

no need to apologize. I am glad to get your feedback. It will make me a better communicator. I thought I was was telling you how to apply the code to what you needed based on the link that assylias posted. – Hinze

@MattRidge: The link that assylias posted will also work on MAC :) See the comment in the answer that I posted. – Hypercritical

Answer 1

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

Hinze

Is there a way to make Application.PathSeparator work with this code so it can work universally with Mac and PC? – End

yes, replace every instance of "\" (usually PC path separator) with Application.PathSeparator - so "C:\Images\" becomes "C:" & Application.PathSeparator & "Images" & Application.PathSeparator ... or you may be able to set Application.PathSepator as a variable and just use the variable name throughout. Probably cleaner that way :) – Hinze

I've been trying to get this to work, the only problem I am running into is that with the code with the Application.PathSeparator entered into it, is that on the Mac there is no C drive, it's \Volumes\Drive Name\Path\... – End

see this website rondebruin.nl/mac.htm ... Ron is pretty good. You can first test to see if you are on a Mac or PC, then set your path variable accordingly. Like IF MAC Then strPath = \\Volumes\Drive\Name\Path ELSE strPath = "C:\..." END IF. If you need help getting that set up, please post another question. – Hinze

He is, but he uses a Mac specific script when it comes to the Mac Side, there has to be another way. I have this script to create a log, and it works on a Mac or PC... #10404017 But the thing is that it uses the path of the document as the parent, not a different directory entirely on a different drive. – End

Right, but you have a way to test if it's Mac / PC. Then once you know, you know how to create the snytax to get at the drive you want on both, no? – Hinze

Yes, but then that means writing the code twice... not exactly fast code concept if you get my drift. This is what I mean. Lets say that the folder where everything is going is going to be on S:/Images/ for windows. On the Mac it is /Volumes/Images/. I can't imagine that a volume letter is the one thing keeping it all from coming together? – End

Its not writing the code twice, its simply using an If statement using Instr(1,Application.OperatingSystem,"MAC") to test if you are on MAC or PC and setting the strPath variable accordingly. You then pass the strPath to the rest of your code, or at least most of it. See my comment from above, 2 comments ago. It may not be the only thing left to get it from coming together, but you have to work in increments and see you can make each element work... in this way you build your code step by step, refactoring it along the way as you need to. Just try to solve one problem at a time. – Hinze

This really bothers me, but I guess I'll have to live with this. I really don't like how coding differs between the Mac and PC even though Excel was designed for the Mac first. – End

I hear yeah... but after all is said and done, you'll be a way better coder! If its any consolation. – Hinze

Ok, solved the Mac and PC issue, rather smartly if I say so myself. I only have one question with the code above now. I have a range of cells to go through, I will need to do something like A3: A & lastrow. I believe it will work in the script you provided above, but I want to verify before I go forward with it. If I change the range for part in C1 to C3:C lastrow, will it still function the same way? Because the way you have it for an individual row, not multiple if I am reading it correctly. Thanks again. – End

Updated original post with full text, a copy of worksheet I'm on, and with a new problem...with my old code, and your code combined. – End

try wrapping "(" around strPath & strComp & "\" & strPart in FolderCreate strPath & strComp & "\" & strPart. Also, this may just be the way it was pasting into the comment box, but place a space between the ")" and "T" in strComp)Then. – Hinze

Matt. Your original question has been answered already. Please post a new question, so that the structure of how Q&A works remains intact. With your edits, the accepted answer no longer matches the original question. If you leave this Q as is, and start a new one, others can track A LOT easier. I am happy to help you with your issue, but I won't offer any more answers in this Q. And please revert this question back to it's original state. – Hinze

thanks for this! works like a charm with minor changes, since there's a function StrComp in Excel 2010. – Supinate

As stated by @MartinDreher, now there is a function strComp. So you should change the name of the variable strComb – Unbiased

Answer 2

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
    Next
End Sub

Oneupmanship

underrated solution – Inglenook

Just be careful strPath doesn't include a filename after the final "\" or this code will create a folder with that name. – Ortolan

fantastic solution. A slight improvement is to use Dir(strCheckPath, vbDirectory) = "" instead of calling Len. – Emperor

This does not work with UNC paths that start with \\. I added two checks but that feels like a hack: If strCheckPath <> "\" And strCheckPath <> "\\" Then – Entomo

This is a good answer as well https://mcmap.net/q/391266/-filesystemobject-createfolder-to-create-directory-and-subdirectories – Casa

Answer 3

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

Abel

This works great for just creating the folder, but it doesn't wait for the command to end. So if you try to copy a file to your new folder just after this, it will fail. – Breena

Just put another command to check while it doesn't exist and don't copy anything in there. – Abel

If accidentally YourPath is "//" or "\\" - it will hang. If something like "::" - it will proceed, will fail, and you will not know it failed. If just a string (not a path), e.g. "ABBA" - the folder will be created in your CurDir (a different location than the file's filder). A proper method for checking folder existence is FileSystemObject.FolderExists(YourPath) – Centrifuge

@Breena I got around this by using WScript object: Set wsh = CreateObject("WScript.Shell"); wsh.Run "cmd /c mkdir """ & YourPath & """", 0, True This will wait until the cmd is finished – Atrocity

Answer 4

Private Sub CommandButton1_Click()
    Dim fso As Object
    Dim fldrname As String
    Dim fldrpath As String

    Set fso = CreateObject("scripting.filesystemobject")
    fldrname = Format(Now(), "dd-mm-yyyy")
    fldrpath = "C:\Temp\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
        fso.createfolder (fldrpath)
    End If
End Sub

Unshaped

This will fail if more subfolder levels are needed. Although it may work if only one folder needs to be created. – Centrifuge

Answer 5

Function MkDir(ByVal strDir As String)
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(strDir) Then
        ' create parent folder if not exist (recursive)
        MkDir (fso.GetParentFolderName(strDir))
        ' doesn't exist, so create the folder
        fso.CreateFolder strDir
    End If
End Function

Lawanda

Please explain why this answer is better than any of the other 12, given 7 years ago. – Saprophyte

Welcome to Stack Overflow! Here is a guide on How to Answer. Code-only answers are considered low quality: make sure to provide an explanation what your code does and how it solves the problem. – Brandebrandea

This Solution is cleaner. It relies more on Windows file scripting host functions rather than 3 clunky vba modules. It gets my vote. – Ultravirus

Answer 6

There are some good answers on here, so I will just add some process improvements. A better way of determining if the folder exists (does not use FileSystemObjects, which not all computers are allowed to use):

Function FolderExists(FolderPath As String) As Boolean
     FolderExists = True
     On Error Resume Next
     ChDir FolderPath
     If Err <> 0 Then FolderExists = False
     On Error GoTo 0
End Function

Likewise,

Function FileExists(FileName As String) As Boolean
     If Dir(FileName) <> "" Then FileExists = True Else FileExists = False
EndFunction

Latvian

Answer 7

All other answers are unnecessarily compicated! You can create all folder tree recursively with 2 lines of code, check this:

Public Sub MkDir_recursive(ByVal folder As String)
    'Dim fso As Object : Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fso As New FileSystemObject 'If this throws an error, use above declaration instead
    ' Create parent folder if necessary (recursive)
    If Not fso.FolderExists(fso.GetParentFolderName(folder)) Then MkDir_recursive fso.GetParentFolderName(folder)
    If Not fso.FolderExists(folder) Then fso.CreateFolder folder 'All subfolders exist when we get here.
End Sub

The sub checks if parent folder does not exist, and in this case it calls the same sub with parent folder, which does the same on and on. This goes on until the folder exists or it reaches the root folder (which will always exist). When

Note: also works with UNC folders (like \\server\myshare\folder)

---

I don´t have access to any MAC, but you can use the same concept, it is very simple.

Lens

Probably the least verbose solution here, worked fine for me – Artiste

Answer 8

For those looking for a cross-platform way that works on both Windows and Mac, the following works:

Sub CreateDir(strPath As String)
    Dim elm As Variant
    Dim strCheckPath As String

    strCheckPath = ""
    For Each elm In Split(strPath, Application.PathSeparator)
        strCheckPath = strCheckPath & elm & Application.PathSeparator
        If (Len(strCheckPath) > 1 And Not FolderExists(strCheckPath)) Then
            MkDir strCheckPath
        End If
    Next
End Sub

Function FolderExists(FolderPath As String) As Boolean
     FolderExists = True
     On Error Resume Next
     ChDir FolderPath
     If Err <> 0 Then FolderExists = False
     On Error GoTo 0
End Function

Kilpatrick

Answer 9

Here's short sub without error handling that creates subdirectories:

Public Function CreateSubDirs(ByVal vstrPath As String)
   Dim marrPath() As String
   Dim mint As Integer

   marrPath = Split(vstrPath, "\")
   vstrPath = marrPath(0) & "\"

   For mint = 1 To UBound(marrPath) 'walk down directory tree until not exists
      If (Dir(vstrPath, vbDirectory) = "") Then Exit For
      vstrPath = vstrPath & marrPath(mint) & "\"
   Next mint

   MkDir vstrPath

   For mint = mint To UBound(marrPath) 'create directories
      vstrPath = vstrPath & marrPath(mint) & "\"
      MkDir vstrPath
   Next mint
End Function

Sententious

Answer 10

Never tried with non Windows systems, but here's the one I have in my library, pretty easy to use. No special library reference required.

Function CreateFolder(ByVal sPath As String) As Boolean
'by Patrick Honorez - www.idevlop.com
'create full sPath at once, if required
'returns False if folder does not exist and could NOT be created, True otherwise
'sample usage: If CreateFolder("C:\toto\test\test") Then debug.print "OK"
'updated 20130422 to handle UNC paths correctly ("\\MyServer\MyShare\MyFolder")

    Dim fs As Object 
    Dim FolderArray
    Dim Folder As String, i As Integer, sShare As String

    If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1)
    Set fs = CreateObject("Scripting.FileSystemObject")
    'UNC path ? change 3 "\" into 3 "@"
    If sPath Like "\\*\*" Then
        sPath = Replace(sPath, "\", "@", 1, 3)
    End If
    'now split
    FolderArray = Split(sPath, "\")
    'then set back the @ into \ in item 0 of array
    FolderArray(0) = Replace(FolderArray(0), "@", "\", 1, 3)
    On Error GoTo hell
    'start from root to end, creating what needs to be
    For i = 0 To UBound(FolderArray) Step 1
        Folder = Folder & FolderArray(i) & "\"
        If Not fs.FolderExists(Folder) Then
            fs.CreateFolder (Folder)
        End If
    Next
    CreateFolder = True
hell:
End Function

Sirenasirenic

Answer 11

This works like a charm in AutoCad VBA and I grabbed it from an excel forum. I don't know why you all make it so complicated?

FREQUENTLY ASKED QUESTIONS

Question: I'm not sure if a particular directory exists already. If it doesn't exist, I'd like to create it using VBA code. How can I do this?

Answer: You can test to see if a directory exists using the VBA code below:

(Quotes below are omitted to avoid confusion of programming code)

---

If Len(Dir("c:\TOTN\Excel\Examples", vbDirectory)) = 0 Then

   MkDir "c:\TOTN\Excel\Examples"

End If

---

http://www.techonthenet.com/excel/formulas/mkdir.php

Bazaar

Your own link points out that mkdir can't create parent directories. – Chandelle

Answer 12

I know this has been answered and there were many good answers already, but for people who come here and look for a solution I could post what I have settled with eventually.

The following code handles both paths to a drive (like "C:\Users...") and to a server address (style: "\Server\Path.."), it takes a path as an argument and automatically strips any file names from it (use "\" at the end if it's already a directory path) and it returns false if for whatever reason the folder could not be created. Oh yes, it also creates sub-sub-sub-directories, if this was requested.

Public Function CreatePathTo(path As String) As Boolean

Dim sect() As String    ' path sections
Dim reserve As Integer  ' number of path sections that should be left untouched
Dim cPath As String     ' temp path
Dim pos As Integer      ' position in path
Dim lastDir As Integer  ' the last valid path length
Dim i As Integer        ' loop var

' unless it all works fine, assume it didn't work:
CreatePathTo = False

' trim any file name and the trailing path separator at the end:
path = Left(path, InStrRev(path, Application.PathSeparator) - 1)

' split the path into directory names
sect = Split(path, "\")

' what kind of path is it?
If (UBound(sect) < 2) Then ' illegal path
    Exit Function
ElseIf (InStr(sect(0), ":") = 2) Then
    reserve = 0 ' only drive name is reserved
ElseIf (sect(0) = vbNullString) And (sect(1) = vbNullString) Then
    reserve = 2 ' server-path - reserve "\\Server\"
Else ' unknown type
    Exit Function
End If

' check backwards from where the path is missing:
lastDir = -1
For pos = UBound(sect) To reserve Step -1

    ' build the path:
    cPath = vbNullString
    For i = 0 To pos
        cPath = cPath & sect(i) & Application.PathSeparator
    Next ' i

    ' check if this path exists:
    If (Dir(cPath, vbDirectory) <> vbNullString) Then
        lastDir = pos
        Exit For
    End If

Next ' pos

' create subdirectories from that point onwards:
On Error GoTo Error01
For pos = lastDir + 1 To UBound(sect)

    ' build the path:
    cPath = vbNullString
    For i = 0 To pos
        cPath = cPath & sect(i) & Application.PathSeparator
    Next ' i

    ' create the directory:
    MkDir cPath

Next ' pos

CreatePathTo = True
Exit Function

Error01:

End Function

I hope someone may find this useful. Enjoy! :-)

Fictionalize

Answer 13

This is a recursive version that works with letter drives as well as UNC. I used the error catching to implement it but if anyone can do one without, I would be interested to see it. This approach works from the branches to the root so it will be somewhat usable when you don't have permissions in the root and lower parts of the directory tree.

' Reverse create directory path. This will create the directory tree from the top    down to the root.
' Useful when working on network drives where you may not have access to the directories close to the root
Sub RevCreateDir(strCheckPath As String)
    On Error GoTo goUpOneDir:
    If Len(Dir(strCheckPath, vbDirectory)) = 0 And Len(strCheckPath) > 2 Then
        MkDir strCheckPath
    End If
    Exit Sub
' Only go up the tree if error code Path not found (76).
goUpOneDir:
    If Err.Number = 76 Then
        Call RevCreateDir(Left(strCheckPath, InStrRev(strCheckPath, "\") - 1))
        Call RevCreateDir(strCheckPath)
    End If
End Sub

Shluh

Doesn't work - MkDir cannot create parent directories – Mazard

Answer 14

Sub FolderCreate()
    MkDir "C:\Test"
End Sub

Needlewoman

As it’s currently written, your answer is unclear. Please edit to add additional details that will help others understand how this addresses the question asked. You can find more information on how to write good answers in the help center. – Savannahsavant

Answer 15

Sub MakeAllPath(ByVal PS$)
    Dim PP$
    If PS <> "" Then
        ' chop any end  name
        PP = Left(PS, InStrRev(PS, "\") - 1)
        ' if not there so build it
        If Dir(PP, vbDirectory) = "" Then
            MakeAllPath Left(PP, InStrRev(PS, "\") - 1)
            ' if not back to drive then  build on what is there
            If Right(PP, 1) <> ":" Then MkDir PP
        End If
    End If
End Sub


'Martins loop version above is better than MY recursive version
'so improve to below

Sub MakeAllDir(PathS$)            

  ' format "K:\firstfold\secf\fold3"

  If Dir(PathS) = vbNullString Then     

 ' else do not bother

   Dim LI&, MYPath$, BuildPath$, PathStrArray$()

   PathStrArray = Split(PathS, "\")

      BuildPath = PathStrArray(0) & "\"    '

      If Dir(BuildPath) = vbNullString Then 

' trap problem of no drive :\  path given

         If vbYes = MsgBox(PathStrArray(0) & "< not there for >" & PathS & " try to append to " & CurDir, vbYesNo) Then
            BuildPath = CurDir & "\"
         Else
            Exit Sub
         End If
      End If
      '
      ' loop through required folders
      '
      For LI = 1 To UBound(PathStrArray)
         BuildPath = BuildPath & PathStrArray(LI) & "\"
         If Dir(BuildPath, vbDirectory) = vbNullString Then MkDir BuildPath
      Next LI
   End If 

 ' was already there

End Sub

' use like
'MakeAllDir "K:\bil\joan\Johno"

'MakeAllDir "K:\bil\joan\Fredso"

'MakeAllDir "K:\bil\tom\wattom"

'MakeAllDir "K:\bil\herb\watherb"

'MakeAllDir "K:\bil\herb\Jim"

'MakeAllDir "bil\joan\wat" ' default drive

Nath