Check for folder; create if it does not exist

Hi everyone. I'm new to VBA and new to this site.

I need to automate a few tasks in a file, then saveas to a folder. I need to see if the folder exists. If not, create the folder. I have a start. Could someone please let me know how to accomplish this? I'm not sure what matters here... I'm using VBA in Excel 2003 on an XP Pro system.

The folder should be in the root of C: and be called 'P2P User Folder' or something similar.

Code:

---

Sub Master()
 '
 ' Master Macro
 ' Macro recorded 4/20/2006 by CompuCat
 '
 ' Keyboard Shortcut: Ctrl+m
 '
 Application.DisplayAlerts = False
    Rows("1:1").Select
    Range("F1").Activate
    Selection.Delete Shift:=xlUp
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
 [This is where I need to see if the folder exists, and then create it, if it does not]
    ChDir "C:\P2P User Folder"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\P2P User Folder\newuser.csv" _
        , FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\P2P User Folder\chguser.csv" _
        , FileFormat:=xlCSV, CreateBackup:=False
 End Sub

---

Thanks, and I appreciate any advice you have.

CompuCat

Hi,

im quite new too. try this

Code:

---

Public Sub createNewDirectory(directoryName As String)
If Not DirExists(directoryName) Then
MkDir (directoryName)
End If
End Sub
 
Function DirExists(DirName As String) As Boolean
On Error GoTo ErrorHandler
DirExists = GetAttr(DirName) And vbDirectory
ErrorHandler:
End Function

---

hope this helps

:hi:

This function checks a path to ensure it has a trailing path seperator, and that the path gets created if it doesn't exist. Two arguments to set, the path to the folder, then True if you want the folder created. I tried to implement it within your existing code, and it created a folder Named "P2P User Folder" on my C:\ drive, and saved 2 csv files into it. You may want to use SaveCopyAs instead of SaveAs depending on what your doing.


[vba]
Public Function fCheckPath(ByRef FolderPath As String, _
Optional ByVal CreatePath As Boolean = False) As String
Dim s() As String
Dim d As String
Dim i As Integer
If CreatePath Then
'If they supplied an ending path seperator, cut it for now
If Right$(FolderPath, 1) = Chr(92) Then _
FolderPath = Left$(FolderPath, Len(FolderPath) - 1)

s = Split(FolderPath, Chr(92))

d = s(0)
For i = 1 To UBound(s)
d = d & Chr(92) & s(i)
If Len(Dir(d, vbDirectory)) = 0 Then MkDir d
Next i
End If

If Not Right$(FolderPath, 1) = Chr(92) Then _
fCheckPath = FolderPath & Chr(92): Exit Function
fCheckPath = FolderPath
End Function

Sub Master()
'
' Master Macro
' Macro recorded 4/20/2006 by CompuCat
'
' Keyboard Shortcut: Ctrl+m
'
Dim szSavePath As String

Application.DisplayAlerts = False
Rows("1:1").Select
Range("F1").Activate
Selection.Delete Shift:=xlUp
Columns("P:P").Select
Selection.Delete Shift:=xlToLeft
szSavePath = fCheckPath("C:\P2P User Folder", True)
ActiveWorkbook.SaveAs Filename:= _
szSavePath & "newuser.csv" _
, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
szSavePath & "chguser.csv" _
, FileFormat:=xlCSV, CreateBackup:=False
End Sub
[/vba]

Another option would be to use the FileSystemObject

Code:

---

Dim fso As Object
Const FLDR_NAME As String = "C:\P2P User Folder\"

    Set fso = CreateObject("Scripting.FileSystemObject")
   
    If Not fso.FolderExists(FLDR_NAME) Then
        fso.CreateFolder (FLDR_NAME)
    End If
   
    'save the file
    ActiveWorkbook.SaveAs Filename:= _
    FLDR_NAME & "newuser.csv" _
    , FileFormat:=xlCSV, CreateBackup:=False

---

Why bother checking, just create it with error handling

[vba]
On Error Resume Next
MkDir directoryname
On Error Goto 0
[/vba]

Don't you love VBA - there's always more than one way to skin a cat! I'm constantly finding that even though I know one (or two) methods to accomplish something, someone else can get the same result in half the amount of code.:clever:

By the way, welcome to the Board CompuCat!

Why not just use Dir?

Code:

---

Sub TestForDir()
Dim strDir As String
    strDir = "C:\My Documents\TestDir\"
   
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        MsgBox "Directory exists."
    End If
End Sub

---

Quote:

---

Originally Posted by Norie

Why not just use Dir?

Code:

---

Sub TestForDir()
Dim strDir As String
    strDir = "C:\My Documents\TestDir\"
   
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        MsgBox "Directory exists."
    End If
End Sub

---

---

Beautiful, Norie. As usual.

After almost 8 years ???

I built it. You joined a year ago. LOL

WOW over 10 year old post!!!!!!
I am trying xld's error method but bookmarking the post.
BTW, my best practice is always to copy address bar and post in as comment in code!
Thanks

Often you need sub directories like F:\fred\jim\bert\helpa1\ and so far only F:\fred\jim\ exist
good old Fso and error checking I do not like ??? so

Code:

---

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

---

Hopefully the Drive exists

Although using fso is the best option, in using mkdir I'd use:

Code:

---

Sub M_snb()
  sn = Split("F:\fred\jim\bert\helpa1\", "\")
  j = 1
  c00 = sn(0) & "\" & sn(j)
 
  Do Until Dir(c00, 16) <> ""
    MkDir c00
    j = j + 1
    c00 = c00 & "\" & sn(j)
  Loop
End Sub

---

does M_Snb build the others of an existing directory


RmDir "F:\fred\jim\bert\helpa1\"
RmDir "F:\fred\jim\bert\"
' RmDir "F:\fred\jim\"

then no helpal directory is built ????? as fred has subdir jim

Hello all :hi:

Eleven years since it was originally posted and I found this thread very helpful :)

Thanks all

Thanks all .
This post save me in 2018 :hi:

I have similar question, I need to create folder structures and have made this code that does almost everything I need. The problem arise when the code tries to create a folder that has a non valid path to it (meaning that there is a folder before it that is missing).

So far I have seen two problems that might arise when I use this code, the folder already exist or the path is missing a part in it.

I want to the code to move through the entire structure and create all folders, so when there already is a existing folder or a folder link is needed I want a message box to promt the issue and what folder is missing. (preferably I would like a yes/no question if I want to create the missing folder but that is just a bonus).


I have tried using On error goto but cant really get it to work as I am not that familiar with error trapping/handling since before now I have always built macros for personal use and because of that I could always just error handle myself as it happens.

Code:

---

Sub MakeSelectionDir2()

Application.ScreenUpdating = False


On Error GoTo ErrHand


Range("C10").Select



Do Until ActiveCell.Value = "STOP"


dir2 = ActiveCell.Offset(0, 1)




    If Len(Dir(dir2, vbDirectory)) > 0 Then
   
 
      MsgBox "(" & dir2 & ") Folder already exist"
   
     
      Else
     

        MkDir dir2
       
       
       
    End If
   
   
    ActiveCell.Offset(1, 0).Range("A1").Select
       
   
Loop




Application.ScreenUpdating = True


Range("D10").Select


End Sub

---

I had the same problem. I figured I could use Nories old and clean code, then extend it a little bit. Here is my solution:
Sub TestForDir()
Dim strDir As String, tmpDir As String, TestChr As String, DirTest As String
Dim Counter As Integer
strDir = "C:\Users\XXX\Desktop\TestFolder\TestTwo"

For Counter = 1 To Len(strDir)
tmpDir = Left(strDir, Counter - 1)
TestChr = Mid(strDir, Counter, 1)
DirTest = Dir(tmpDir, vbDirectory)

If DirTest = "" And TestChr = "" Then
MkDir tmpDir
MsgBox "Created:" & tmpDir
End If
Next Counter
End Sub

Quote:

---

Originally Posted by Johan90

I have similar question, I need to create folder structures and have made this code that does almost everything I need. The problem arise when the code tries to create a folder that has a non valid path to it (meaning that there is a folder before it that is missing).

So far I have seen two problems that might arise when I use this code, the folder already exist or the path is missing a part in it.

I want to the code to move through the entire structure and create all folders, so when there already is a existing folder or a folder link is needed I want a message box to promt the issue and what folder is missing. (preferably I would like a yes/no question if I want to create the missing folder but that is just a bonus).


I have tried using On error goto but cant really get it to work as I am not that familiar with error trapping/handling since before now I have always built macros for personal use and because of that I could always just error handle myself as it happens.

Code:

---

Sub MakeSelectionDir2()

Application.ScreenUpdating = False


On Error GoTo ErrHand


Range("C10").Select



Do Until ActiveCell.Value = "STOP"


dir2 = ActiveCell.Offset(0, 1)




    If Len(Dir(dir2, vbDirectory)) > 0 Then
   
 
      MsgBox "(" & dir2 & ") Folder already exist"
   
     
      Else
     

        MkDir dir2
       
       
       
    End If
   
   
    ActiveCell.Offset(1, 0).Range("A1").Select
       
   
Loop




Application.ScreenUpdating = True


Range("D10").Select


End Sub

---

---

Quote:

---

Originally Posted by Norie

Why not just use Dir?

Code:

---

Sub TestForDir()
Dim strDir As String
    strDir = "C:\My Documents\TestDir\"
   
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        MsgBox "Directory exists."
    End If
End Sub

---

---

Thank you so much for this elegant code! I registered just to reply because it has been SO helpful -- It has helped me extend a UDF by David Hager to test for specified path and add it if needed, all before opening said directory!

For those interested, here's how my code looks in combination with David Hager's.

Code:

---

Function ValidateHyperlink(Optional vFolderPath As String = "C:\")


'Trigger with changed value in another cell with this wording: "=B1&FollowHyperlink()"


    'Code tests to see if the path exists.  If not, it makes the directory before opening it.  If it does, it opens it.
Dim strDir As String
    strDir = vFolderPath
   
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    'Else
    '  MsgBox "Directory exists."
    End If


On Error Resume Next
    ThisWorkbook.FollowHyperlink [vFolderPath]


End Function

---