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

User · Answer

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  amp  FolderArray i   amp              If Not fs FolderExists Folder  Then             fs CreateFolder  Folder          End If     Next     CreateFolder   True hell  End Function

User · Answer

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  amp  strComp  Then   company doesn t exist  so create full path     FolderCreate strPath  amp  strComp  amp       amp  strPart Else  company does exist  but does part folder     If Not FolderExists strPath  amp  strComp  amp       amp  strPart  Then         FolderCreate strPath  amp  strComp  amp       amp  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     amp  path  amp     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

User · Answer

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   amp          For mint   1 To UBound marrPath   walk down directory tree until not exists       If  Dir vstrPath  vbDirectory        Then Exit For       vstrPath   vstrPath  amp  marrPath mint   amp         Next mint     MkDir vstrPath     For mint   mint To UBound marrPath   create directories       vstrPath   vstrPath  amp  marrPath mint   amp            MkDir vstrPath    Next mint End Function

User · Answer

Sub MakeAllPath ByVal PS       Dim PP      If PS  lt  gt     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   lt  gt      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 amp   MYPath   BuildPath   PathStrArray        PathStrArray   Split PathS              BuildPath   PathStrArray 0   amp                  If Dir BuildPath    vbNullString Then     trap problem of no drive     path given           If vbYes   MsgBox PathStrArray 0   amp    lt  not there for  gt    amp  PathS  amp    try to append to    amp  CurDir  vbYesNo  Then             BuildPath   CurDir  amp               Else             Exit Sub          End If       End If                 loop through required folders               For LI   1 To UBound PathStrArray           BuildPath   BuildPath  amp  PathStrArray LI   amp               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

User · Answer

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  quot c  TOTN Excel Examples quot   vbDirectory     0 Then     MkDir  quot c  TOTN Excel Examples quot   End If   http   www techonthenet com excel formulas mkdir php

User · Answer

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      amp  YourPath  amp        End If

User · Answer

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  amp  elm  amp              If Len Dir strCheckPath  vbDirectory     0 Then MkDir strCheckPath     Next End Sub

User · Answer

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  lt  gt  0 Then FolderExists   False      On Error GoTo 0 End Function   Likewise   Function FileExists FileName As String  As Boolean      If Dir FileName   lt  gt     Then FileExists   True Else FileExists   False EndFunction

User · Answer

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    amp  fldrname     If Not fso FolderExists fldrpath  Then         fso createfolder  fldrpath      End If End Sub

User · Answer

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

User · Answer

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

User · Answer

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  amp  elm  amp  Application PathSeparator         If  Len strCheckPath   gt  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  lt  gt  0 Then FolderExists   False      On Error GoTo 0 End Function

User · Answer

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   lt  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  amp  sect i   amp  Application PathSeparator     Next   i        check if this path exists      If  Dir cPath  vbDirectory   lt  gt  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  amp  sect i   amp  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   -

[excel] Create a folder and sub folder in Excel VBA

Examples related to excel

Examples related to vba

Examples related to macos

Examples related to directory

Examples related to create-directory