Save My Workbook with Two Different Names..

[omairhe]

Hello Excel Gurus,

How to save ThisWorkbook with two different names and locations please.

In cell H2 and H3 is the filename already been given in the sheet named HSheet of ThisWorkbook, generated via formula.

H2=

C:\Users\Kris Bryant\Share\2020\11-2020.xlsb

H3=

C:\Users\Kris Bryant\Share\2020\12-2020.xlsb

OR
H3=

C:\Users\Kris Bryant\Share\2021\01-2021.xlsb

You could see that not just the filenames are different but the locations can also be different for each file as well. However, the location of H3 does not exisit yet in windows explorer directory . So the code should be able to make one for saving the file inside that location. For example, 2021\
For H2 the location is already been made. And in case if the file already exists then overwrite it without any prompts. I hope it can be made possible.

Thanks and will appreciate a whole lot.

 

[Anthony47]

You may use the SaveCopyAs method...
If you already save the workbook using a macro, just add the line

ThisWorkbook.SaveCopyAs ThisWorkbook.Sheets("HSheet").Range("H3").Value

Otherwise you should consider adding a "BeforeSave" macro:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.SaveCopyAs ThisWorkbook.Sheets("HSheet").Range("H3").Value
End Sub

This code have to be inserted into the module "ThisWorkbook" of your vba project

Bye

 

[omairhe]

ThisWorkbook.SaveCopyAs ThisWorkbook.Sheets("HSheet").Range("H3").Value

Neat trick there. I am using your first code. What about the folder creation part? Will it be just as simple to create directory if it doesn't exist? Thanks as always.

 

[Anthony47]

Ok, it's a bit trickier; try with this snippet:

'Declaration, at the beginning of the Sub
Dim lFso As Boolean, mySplit, FnPath As String


Set myFSO = CreateObject("Scripting.FileSystemObject")
FnPath = ThisWorkbook.Sheets("HSheet").Range("H3").Value
'
mySplit = Split(FnPath, "\", , vbTextCompare)
If myFSO.FolderExists(Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)) Then
    Debug.Print "OK---> "; Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)
Else
    MkDir Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)
    Debug.Print "New--> "; Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)
End If
Set myFSO = Nothing
'Save Copy:
ThisWorkbook.SaveCopyAs ThisWorkbook.Sheets("HSheet").Range("H3").Value

The Debug.Print lines are just for debuging; if it works ok then you can remove both the lines (but if they stay there it isn't a problem)

Bye

 

[omairhe]

Ok, it's a bit trickier; try with this snippet:

'Declaration, at the beginning of the Sub
Dim lFso As Boolean, mySplit, FnPath As String


Set myFSO = CreateObject("Scripting.FileSystemObject")
FnPath = ThisWorkbook.Sheets("HSheet").Range("H3").Value
'
mySplit = Split(FnPath, "\", , vbTextCompare)
If myFSO.FolderExists(Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)) Then
    Debug.Print "OK---> "; Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)
Else
    MkDir Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)
    Debug.Print "New--> "; Replace(FnPath, "\" & mySplit(UBound(mySplit)), "", , , vbTextCompare)
End If
Set myFSO = Nothing
'Save Copy:
ThisWorkbook.SaveCopyAs ThisWorkbook.Sheets("HSheet").Range("H3").Value

The Debug.Print lines are just for debuging; if it works ok then you can remove both the lines (but if they stay there it isn't a problem)

Bye

Thanks Anthony.