Probems putting folders into other folders based on user input.

**AnthonyWB** · 08-13-2010, 11:02 AM

Hello everyone. I recently developed some script which will produce a series of folders based on a user inputing a date that it is enetered in a message box using the dd-mmm-yyyy format. The date that is entered is always the last day of a quarter. So for example it will be one of the following:

i. March 31
ii. June 30
iii. September 30
iv. December 31

Now what I have are four folders labeled

1. 1 Quarter
2. 2 Quarter
3. 3 Quarter
4. 4 Quarter

And here is where I am stuck If the user enters a date of say 30-Jun-2010 as you can see form the code below it will produce the following:

A. a folder labeled 30-Jun-2010...and some subfolders
B. a folder labeled 31-May-2010...and some subfolders
C. a folder labeled 30-Apr-2010...and some subfolders

Now what I cannot fogure out is how to take A,B and C and place them into the 2 Quarter folder. Similairyl if a user enters the date of 31-Mar-2010 then the folders that are created by the script need to be put into the 1 Quarter folder...and so on. Any help is appreciated.

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:\"

    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

**davegugg** · 08-13-2010, 02:59 PM

Do these Quarter folders already exists, or are you trying to create them first to put your other folders inside of?

**AnthonyWB** · 08-13-2010, 03:36 PM

The folders already exist.

**davegugg** · 08-13-2010, 03:59 PM

Ok, assuming the Quarter folders are at L:\Quarter1 etc. the following code will add the quarter name to the path:

Select Case Month(fpath)

Case 1, 2, 3
    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

I'd put it right after where you define fpath as L:\

**AnthonyWB** · 08-13-2010, 04:15 PM

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

**davegugg** · 08-13-2010, 04:19 PM

I'm sorry, I can't believe I copied that wrong. It should be

Select Case Month(fDate)

**AnthonyWB** · 08-13-2010, 04:47 PM

We are close, now it tells me that "those folder already existed"

**AnthonyWB** · 08-13-2010, 04:58 PM

According to the intermediate window there is an error here:

Case Month(fDate)

with an "expected expression"

**davegugg** · 08-13-2010, 05:13 PM

What line does the code stop on when it crashes?

**AnthonyWB** · 08-16-2010, 09:40 AM

It does not crash. It simply tells me the folders already exist when in fact they do not. Any other suggestions?

**davegugg** · 08-16-2010, 12:16 PM

Run the code to the first MkDir Fldr. (You can put in bookmarks to stop the code in a certain spot by clicking the margin to the left of the code.)
Type the following into the immediate window, and hit enter:

Debug.Print Fldr

This will show you that path of the folder you are attempting to create. Check and make sure it does not exist.

Probems putting folders into other folders based on user input.

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Re: Probems putting folders into other folders based on user input.

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions