Macro to save duplicate file and create folder name based on cell value

I currently use the following code to create a duplicate file based on two cells within a directory and folder i specify. These cells consist of the team and week commencing date (mondays date of week which is cell 'Main Menu'!K8)

Private Sub Workbook_BeforeSave(ByVal _
  SaveAsUI As Boolean, Cancel As Boolean)
    With ThisWorkbook
        .SaveCopyAs ("\\dfz70588\106124001\workgroup\Fraud Error Strategy Team\Recovery\Roll up work\testfolder\" & Range("'Main Menu'!H5").Value & ("-") & Format(Range("'Main Menu'!K8"), "DD.MM.YYYY") & ".xls")
    End With
End Sub

However I now want to be able to create an archive of past weeks duplicates by creating a folder based on the week commencing date ('Main Menu'!K8). I want the above macro to first check if the folder exists and if not to create it with the date ('Main Menu'!K8), if it does to simply save itself to that folder.

Thanks for any help

Hello munkee,

Will the new path be using the working directory?
Example

  \\dfz70588\106124001\workgroup\Fraud Error Strategy Team\Recovery\Roll up work\testfolder\DD.MM.YYYY\

The directory will be \\dfz70588\106124001\workgroup\Fraud Error Strategy Team\Recovery\Roll up work\testfolder\ Basically it will save the duplicate file to a folder with the name based on the same cell reference that the duplicate file is saved as (the week commencing date).

So all files saved as teamname-weekcommeningdate.xls will be saved in the folder with the weekcommendingdate e.g. 23.11.2009

Then the next week the cell value containing the week commencing date value is change to that mondays date and the files then save with that date attached to that folder name.


e.g.

FR1-23.11.2009.xls
RA10-23.11.2009.xls

will all save to a folder created 23.11.2009 if the folder exists then it should not try to create a new one but just add the file to it. If it does not exist it should create it and add to it.

Giving total path to a file name \\dfz70588\106124001\workgroup\Fraud Error Strategy Team\Recovery\Roll up work\testfolder\23.11.2009\FR1-23.11.2009.xls

In the code in the first post the DD.MM.YYYY is simply the formatting for the way the date will be appended to the filename.

Hello munkee,

It has been a hectic day since tomorrow is Thanksgiving Day here in the states and for most people is a 4 day holiday.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  Dim BackupPath As String
  Dim ParentPath As String
  Dim WorkingDir As String
  
    ParentPath = "\\dfz70588\106124001\workgroup\Fraud Error Strategy Team\Recovery\Roll up work\testfolder\"
    BackupPath = Format(Range("'Main Menu'!K8"), "DD.MM.YYYY")
    
    If Dir(ParentPath & "\" & BackupPath, vbDirectory) = "" Then
      'Make the directory
       WorkingDir = CurDir
         ChDir ParentPath
         MkDir BackupPath
       ChDir WorkingDir
    End If
    
    With ThisWorkbook
        .SaveCopyAs (ParentPath & "\" &  BackupPath &  "\" & Range("'Main Menu'!H5").Value & ("-") & Format(Range("'Main Menu'!K8"), "DD.MM.YYYY") & ".xls")
    End With
    
End Sub