Create and Maintain a Filing System Using VBA

[Pete81]

Hi,

I'm trying to create a command in a file "Directory Creation Test.xlsm" which will, on pressing a button, do the following:

1)Search for a folder, and if it does not find it, create one.
Example: Find the folder "Test" in the directory C:\Filing System, and if it does not exist, create the folder "Test", to produce C:\Filing System\Test

2)If the folder already exists, search for a file with the same name as the value in a cell, and if it does not find it, create one, again using the cell value to decide the file name.
Example: Cell A1 contains the text "Test1". Find the file named after A1 in the directory C:\Filing System\Test, and if it does not exist, create the file and save using the contents of A1 as the file name, to produce C:\Filing System\Test\Test1.xls

3)If the file already exists, then copy the contents of the open worksheet (in which cell A1 = "Test1") and paste them in to the already extant file, in a new sheet, again named after cell A1, then save and close this file.

I've made some progress with this myself, in terms of creating a new folder and a new file, but am stuck as to how to get a new worksheet in to an already existing file.

Below is what I have so far. Excuse the novice hand:

Sub CreateSaveCosting()

Dim FPath As String
Dim FName As String

'creates a new folder named for the contents of cell A1, provided this folder does not already exist.

If Len(Dir("C:\Filing System\Test" & "\" & Range("A1"), vbDirectory)) = 0 Then
   MkDir "C:\Filing System\Test" & "\" & Range("A1")
End If

'Creates a new file named for the contents of cell A1, provided this file does not already exist.

FPath = "C:\Filing System\Test" & "\" & Range("A1").Text
FName = Sheets("Sheet1").Range("A1").Text

If Len(Dir(FPath & "\" & FName)) = 0 Then
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
Exit Sub
End If

'Probably gobbledygook

If Len(Dir(FPath & "\" & FName)) = 1 Then
Workbooks(FPath & "\" & FName).Open
Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Move After:=Sheets(Sheets.Count)
Workbooks("Directory Creation Test").Worksheets("Sheet1").Copy
Workbooks(FName).Worksheets(Sheets.Count).Paste
ActiveSheet.Name = Workbooks("Directory Creation Test").Worksheets("Sheet1").Range("A1").Text
Workbooks(FName).Close
End If


End Sub

I fall apart mentally when I try to create code which will perform stage 3.

The purpose of this is to create a hands-off filing system for the user, that a closed program will maintain for them. Can anyone help?

Thanks in advance.

 

[Pete81]

Apologies, I've jumbled the first two stages a little. They should read:

"1)Search for a folder named after the value in a cell, and if it does not find it, create one.
Example: Cell A1 contains the text "Test1". Find the folder "Test1" in the directory C:\Filing System, and if it does not exist, create the folder "Test1", to produce C:\Filing System\Test1

2)If the folder already exists, search for a file with the same name as the value in a cell, and if it does not find it, create one, again using the cell value to decide the file name.
Example: Cell A1 contains the text "Test1". Find the file named after A1 in the directory C:\Filing System\Test1, and if it does not exist, create the file and save using the contents of A1 as the file name, to produce C:\Filing System\Test1\Test1.xls"

 

[Pete81]

Anything at all regarding the above issue? I can get stages 1 and 2 to work, but not stage 3.