VBA only save a copy before closing if the workbook's file names last characters is certain text

[annayujeanlee]

Hi,

I'm trying to only save a copy of a workbook upon closing if the last 7 characters of the workbook's name is results, else does not save. The specific reason for this is because there are different versions of the same workbook that people tend to save to edit on their own and they still contain the word results such as "X09EFE Halloween contest test results copy for Matt.xlsx". In addition, I'd like for the new saved copy version's name to grab the first 7 characters of the workbook name & "contest results". So for example, if the workbook's name is "X09EFE Halloween contest test results.xlsx", I'd like the name to save as "X09EFE contest results". Fairly new to Macro's so all I currently have is a script to save the file upon closing.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim CurrDate As String
CurrDate = Format(Date, "MMDDYY")
With ActiveWorkbook
.SaveCopyAs "C:\Users\Test" & _
Left(.Name, InStrRev(.Name, ".") - 1) & ".xlsx"
End With

MsgBox "New file version saved (v. " & CurrDate & ")"


End Sub

 

[rlv01]

.xlsm files can contain macros. .xlsx files cannot. Your name for the example workbook that you want to save a copy of is "X09EFE Halloween contest test results.xlsx" and so cannot contain the macro you posted. In what (.xlsm) workbook will your macro be located?

 

[annayujeanlee]

So sorry. The .xlsx was a typo. The macro will be located in "X09EFE Halloween contest test results.xlsm"

 

[rlv01]

Perhaps something like this.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim WB As Workbook
    Dim FileToSave As String
    Dim CurrDate As String
    Dim SaveFolderPath As String
    Dim TempFileName As String

    If UCase(Split(Me.Name, ".")(1)) = "XLSM" Then
        SaveFolderPath = "C:\Users\Test"
        FileToSave = Trim(Split(ThisWorkbook.Name, ".")(0))
        If UCase(Right(FileToSave, 7)) = "RESULTS" Then
            Application.ScreenUpdating = False
            FileToSave = SaveFolderPath & "\" & Trim(Left(FileToSave, 7)) & " contest results.xlsx"
            TempFileName = SaveFolderPath & "\TempWB$.xlsm"

            CurrDate = Format(Date, "MMDDYY")

            ThisWorkbook.SaveCopyAs TempFileName
            DoEvents
            Set WB = Workbooks.Open(TempFileName)

            Application.DisplayAlerts = False
            WB.SaveAs Filename:=FileToSave, FileFormat:=xlOpenXMLWorkbook
            DoEvents
            Application.DisplayAlerts = True

            WB.Close False
            DoEvents
            Kill TempFileName
            Application.ScreenUpdating = True
            MsgBox "New file version saved (v. " & CurrDate & ")"
        End If
    End If
End Sub

 

[annayujeanlee]

Thank you! This worked fabulously. Much appreciated.