Creating Folders.

Hello everyone. I am using the following VBA code to create a folder:

Option Explicit

Sub CreateFolder()
    Dim fso
    Dim fol As String
        fol = "L:\12_31_2009_157" ' change to match the folder path

    Set fso = CreateObject("Scripting.FileSystemObject")

    If Not fso.FolderExists(fol) Then
    fso.CreateFolder (fol)
    Else
        MsgBox fol & " already exists!", vbExclamation, "Folder Exists"
    End If
    
End Sub

I am trying to create a code that is a little more "dynamic". I want to write VBA code that will create a userform where the user is prompted for the date (MM_DD_YYYY) for instance: "Please Enter the date". The macro will then take that date and create a folder named "MM_DD_YYYY_157. If the folder already exist I need an error message which will promt the user to enter in the correct date, "Incorrect date, please try again!"

Any suggestions would be appreciated.

Here's how I would write that:

code removed...see below

Correction:

Option Explicit

Sub CreateFolder()
Dim fDate As String, fPath As String

fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "MM_DD_YYYY"))
If fDate = "False" Then Exit Sub

fPath = "L:\"

On Error GoTo ErrorExit
    MkDir fPath & fDate & "_157"
    MkDir fPath & fDate & "_157\" & fDate & "_157_Reports"
    MkDir fPath & fDate & "_157\" & fDate & "_157_Support_Summaries"
    Exit Sub
    
ErrorExit:
    MsgBox fPath & fDate & " already exists!", vbExclamation, "Folder Exists"
    
End Sub

You know, now that you're trying to make multiple folders, a little more robust response to finding folders already created is probably in order... try this and try running it on the same date more than once...

Option Explicit

Sub CreateFolder()
Dim fDate As String, fPath As String
Dim Fldr As String, ErrBuf As String

fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "MM_DD_YYYY"))
If fDate = "False" Then Exit Sub

fPath = "L:\"

On Error GoTo ErrorHandler
    Fldr = fPath & fDate & "_157"
    MkDir Fldr
    Fldr = fPath & fDate & "_157\" & fDate & "_157_Reports"
    MkDir Fldr
    Fldr = fPath & fDate & "_157\" & fDate & "_157_Support_Summaries"
    MkDir Fldr
    If Len(ErrBuf) > 0 Then MsgBox "The following folders already existed:" & vbLf & vbLf & ErrBuf
    Exit Sub
    
ErrorHandler:
    ErrBuf = ErrBuf & vbLf & Fldr
    Resume Next
    
End Sub