Match file name to containing folder

Is it possible to automatically rename a file to match the containing folder upon saving?

We have a network folder that contains multiple client folders and in each folder are subfolders for different phases of work and in one of these folders is a macro-enabled Excel file we use for client estimates. Each priamry client folder is named in the format: Client #-Name (200956-Central Bank Florida). What I would like to happen is whenever a new estimate is created and subsequently saved by the user to have that file automatically renamed to match the primary folder (200956-Central Bank Florida) which contains it.

Hopefully this makes sense. I've searched to no luck but I may not be using the correct terms in my search.

Here is an approach. When the user attempts to close the file, the code reads the parent file directory and pulls out the name in parenthesis and then carries out a saveas with the suggested name as the one in parenthesis. The original file is unaffected.

Place this code in the workbook module

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    saveparentname
End Sub

Place the following code in any module

Sub saveparentname()
Dim folder, name As String

folder = ThisWorkbook.Path
name = Mid(folder, WorksheetFunction.Find("(", folder), Len(folder) - WorksheetFunction.Find("(", folder) + 1)
name = Application.GetSaveAsFilename(InitialFileName:=name, FileFilter:="Macro Enabled Workbook (*.xlsm), *.xlsm", Title:="Save As File")
ActiveWorkbook.SaveAs Filename:=name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

I added the first code to VBAProject>MS Excel Objects>ThisWorkbook and the second code to VBAProject>MS Excel Objects>Sheet1 but am getting the following error- 1004 Unable to get the Find Property of the WorksheetFunction class.

Debug shows the error happening on line: name = Mid(folder, WorksheetFunction.Find("(", folder), Len(folder) - WorksheetFunction.Find("(", folder) + 1)

Update the second module to this

Sub saveparentname()
Dim folder, name As String
folder = ThisWorkbook.Path
name = Mid(folder, Application.WorksheetFunction.Find("(", folder), Len(folder) - Application.WorksheetFunction.Find("(", folder) + 1)
name = Application.GetSaveAsFilename(InitialFileName:=name, FileFilter:="Macro Enabled Workbook (*.xlsm), *.xlsm", Title:="Save As File")
ActiveWorkbook.SaveAs Filename:=name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

I think this may not work on your version, but this update is worth a try

I re-wrote the module and removed dependence on Find function

Sub saveparentname()
Dim folder, name As String
folder = ThisWorkbook.Path
name = Mid(folder, InStr(folder, "("), Len(folder) - InStr(folder, "(") + 1)
name = Application.GetSaveAsFilename(InitialFileName:=name, FileFilter:="Macro Enabled Workbook (*.xlsm), *.xlsm", Title:="Save As File")
ActiveWorkbook.SaveAs Filename:=name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

I updated the second module per your last suggestion and am now getting the sub or function not defined error. I cut and paste everything and don't see any typos so don't know why it can't find it.

I've attached screenshots of what I have if it helps

I appreciate your help on this

Attachment 718225Attachment 718227

Did you use the code from post #5?

Yes I did use the code from Post 5.

Just realized my images did not attach properly so I've added them here

Workbook Module.png
Module-1.png
Error.png

Moving into a standard module cleared the compile error however it hangs on line name = Mid(folder, InStr(folder, "("), Len(folder) - InStr(folder, "(") + 1) when running.

I ran into the same error if I open the file when it was not in a folder/directory with a client name. The process I am using is expecting that the file will be moved (through drag/drop in Win Explorer) to the desired directory, than opening the file from that client folder. When the file is closed, the code will read the file's path and read the client name from that path.

The code will throw an error if the file is opened from a path without a client name. If this is how it is going to be used, I can add code for the user to select the path. Is that what you want to do?

Originally Posted by maniacb

I ran into the same error if I open the file when it was not in a folder/directory with a client name. The process I am using is expecting that the file will be moved (through drag/drop in Win Explorer) to the desired directory, than opening the file from that client folder. When the file is closed, the code will read the file's path and read the client name from that path.....

This is the method that we use for our folder structure which looks like this-G:\Shared drives\ML310\2021 ESTIMATES & PROJECTS\210514-21SP0014-Client North Gate\Worksheets-Proposal\Worksheets-Takeoffs. In the Worksheets-Takeoffs folder is where the excel spreadsheet is located.

Here is code that will ask for the directory name at close.

Sub saveparentname()
Dim folder, name As String
On Error Resume Next
With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .AllowMultiSelect = False
        .Show
        folder = .SelectedItems(1)
End With
name = Mid(folder, InStr(folder, "("), Len(folder) - InStr(folder, "(") + 1)
name = Application.GetSaveAsFilename(InitialFileName:=folder & "\" & name, FileFilter:="Macro Enabled Workbook (*.xlsm), *.xlsm", Title:="Save As File")
ActiveWorkbook.SaveAs FileName:=name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

Here is a better solution that will not ask to save in directory if the file is already in a client folder.

Sub saveparentname()
Dim folder, name, fold, nam, namwb As String
On Error Resume Next
fold = ThisWorkbook.Path
nam = Mid(fold, InStr(fold, "("), Len(fold) - InStr(fold, "(") + 1)
namwb = Mid(ThisWorkbook.name, 1, Len(ThisWorkbook.name) - 5)
If nam <> namwb Then
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .AllowMultiSelect = False
        .Show
        folder = .SelectedItems(1)
    End With
    name = Mid(folder, InStr(folder, "("), Len(folder) - InStr(folder, "(") + 1)
    name = Application.GetSaveAsFilename(InitialFileName:=folder & "\" & name, FileFilter:="Macro Enabled Workbook (*.xlsm), *.xlsm", Title:="Save As File")
    ActiveWorkbook.SaveAs FileName:=name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End Sub

Correct no parentheses. The naming (210514-21SP0014-Client North Gate) changes with each new estimate.

210514-21SP0014 estimate number which increases by 1 with each new estimate 210515, 210516, etc.
Client North Gate also changes based upon the actual client/ project. so 210516 might be Bank of America Orlando and 210517 could be Dade County Airport so they will never be the same.

To confirm, in the above example, the file name should be:

210514-21SP0014-Client North Gate

Please confirm

Originally Posted by maniacb

To confirm, in the above example, the file name should be:

210514-21SP0014-Client North Gate

Please confirm

That is correct

I think this latest code will work for what I am looking for. I greatly appreciate all of your time and help on this.