i did that and it tells me I have a "type mismatch. see the code below
Dim fDate As String
Dim fPath As String
Dim fDatePrevious1 As String
Dim fDatePrevious2 As String
Dim fDatePrevious3 As String
Dim fPriorDate1 As String
Dim fPriorDate2 As String
Dim fPriorDate3 As String
Sub CreateFolder()
'***********************************************************************
'CreateFolder() macro creates the folders for the 157 Automation process.
'***********************************************************************
Dim Fldr As String
Dim ErrBuf As String
fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "DD-MMM-YYYY"))
If fDate = "False" Then Exit Sub
fDatePrevious1 = DateSerial(Year(fDate) - 1, Month(fDate), 0)
fPriorDate1 = Format(fDatePrevious1, "DD-MMM-YYYY")
fDatePrevious2 = DateSerial(Year(fDate), Month(fDate) - 1, 0)
fPriorDate2 = Format(fDatePrevious2, "DD-MMM-YYYY")
fDatePrevious3 = DateSerial(Year(fDate), Month(fDate) - 2, 0)
fPriorDate3 = Format(fDatePrevious3, "DD-MMM-YYYY")
fPath = "L:\"
Select Case Month(fPath)
Case 1, 2, 3 <-----------Error Type mismatch
fPath = fPath & "Quarter1\"
Case 4, 5, 6
fPath = fPath & "Quarter2\"
Case 7, 8, 9
fPath = fPath & "Quarter3\"
Case 10, 11, 12
fPath = fPath & "Quarter4\"
End Select
On Error GoTo ErrorHandler
Fldr = fPath & fDate & "_157"
MkDir Fldr
Fldr = fPath & fPriorDate1 & "_157"
MkDir Fldr
Fldr = fPath & fPriorDate2 & "_157"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports"
MkDir Fldr
Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports"
MkDir Fldr
Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Roll_forward_wTA"
MkDir Fldr
Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports\" & "Roll_forward_wTA"
MkDir Fldr
Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports\" & "Roll_forward_wTA"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Terminated"
MkDir Fldr
Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports\" & "Terminated"
MkDir Fldr
Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports\" & "Terminated"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "157_Reports\" & "IBRD_Disclosure"
MkDir Fldr
Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports\" & "IBRD_Disclosure"
MkDir Fldr
Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports\" & "IBRD_Disclosure"
MkDir Fldr
Fldr = fPath & fDate & "_157\" & "105_Reports"
MkDir Fldr
Fldr = fPath & fPriorDate1 & "_157\" & "105_Reports"
MkDir Fldr
Fldr = fPath & fPriorDate2 & "_157\" & "105_Reports"
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
Bookmarks