VBA - Check filename of open workbook for a string

[Lost_in_Excel]

Hi. At work we use a particular workbook each month as simple save it with a new name. This has led to previous workbooks being accidentally overwritten an number of times and giving me several hours of work to reconstruct them.

I've created a template workbook "xxxxxxx_Template" and what I would like is on opening this workbook a macro would check the filename and if the string "Template" is found it prompts the user to save it as a new file.

I've got the msgbox to prompt for the save but it happens on opening every time, for example when the new workbook is saved it now contains the msgbox prompt so I need to check for the "Template" string and not show the dialogue box if it doesn't find it.

I hope I've explained this sufficiently. I made the mistake of adding a couple of very simple macro buttons to hide/unhide columns and now my colleagues think I'm some kind of Excel wizard. I am very much not!!!

Thanks

 

[GWteB]

You might consider actually saving the template workbook as an Excel Macro-Enabled Template (*.xltm). If the template is opened (on default as NEW), a copy is made and opened. The very first attempt to save such a workbook opens the SaveAs dialog box. This forces the user to choose a folder and provide a file name.

 

[Lost_in_Excel]

Hi GWteB, I'm afraid that won't work as I need the newly saved file to be in a specific location on Sharepoint and with a specific name. Some of my colleagues would be fine with this but I'm afraid it would really blow some of them away. At the minute they've got a shortcut to the location on their desktop and they open the latest file and simply rename it.

At the minute my macro does force the location though I still can't get the filename to be input in the Save as dialogue box, but I can live with that.
Can I use a template but set it up so it saves to a specific location?

Thanks for the answer though. I'll have a play around with the template to see if I can get that to work.

 

[GWteB]

I see, maybe the code below is close to what you want. The main procedure can be invoked from the Workbook_Open event handler.
Code determines whether the current workbook's file name ends with the string "_Template". If that turns out to be the case the user is encouraged to save the template with another name. In any other case the code ends without anything else happening. Please note the two separate functions, the Lost_in_Excel procedure is dependent on those.

... though I still can't get the filename to be input in the Save as dialogue box, but I can live with that.

You don't have to, because both file name and destination folder can actually be set as a default within the Save As dialog. This does not alter the fact that the user can still navigate to another folder and is able to change the file name as well. If you know in advance with which file name the copy of the template should be saved, it is obvious to omit the Save As dialog. A notification that the workbook is saved with a different name could then suffice. My code currently uses the Save As dialog, if only to serve as an example.

Public Sub Lost_in_Excel()

    Const TEMPLATE      As String = "_Template"
    Const DESTFOLDER    As String = "C:\Users\Public\SharePoint\"    ' <<< change to suit

    Dim ofn         As Variant
    Dim nfn         As Variant
    Dim Initial     As String
    Dim Filter      As String
    Dim NewFileName As String
    
    
    nfn = False
    ofn = SplitNameExt(ThisWorkbook.FullName)
    
    If StrComp(TEMPLATE, Right(ofn(0), Len(TEMPLATE)), vbTextCompare) = 0 Then
    
        While VarType(nfn) = vbBoolean
    
            MsgBox "Please save this workbook as requested", vbExclamation
        
            NewFileName = "MyWorkBook.xlsm"      ' <<< change to suit
        
            Initial = ProperDir(DESTFOLDER) & NewFileName
            Filter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm"
        
            nfn = Application.GetSaveAsFilename(Initial, Filter)
            If VarType(nfn) <> vbBoolean Then
                ThisWorkbook.SaveAs Filename:=nfn, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Else
                MsgBox "Cancel was pressed", vbInformation
            End If
        Wend
    Else
        'do nothing, currently this code doesn't run in a template workbook
    End If
End Sub


Public Function SplitNameExt(ByVal argFileName As String) As Variant

    ' return with Array: 0 = filename
    '                    1 = extension
    Dim arr(1) As String, ln As Long, p As Long

    arr(0) = argFileName
    p = InStrRev(argFileName, ".", -1, vbTextCompare)
    If p > 0 And InStrRev(argFileName, "\", -1, vbTextCompare) < p Then
        ln = Len(argFileName)
        arr(0) = Left(argFileName, ln - (ln - p + 1))
        arr(1) = Right(argFileName, ln - p)
    End If
    SplitNameExt = arr
End Function


Public Function ProperDir(ByVal argFolderPath As String) As String
    If Right(argFolderPath, 1) = "\" Then
        ProperDir = argFolderPath
    Else
        ProperDir = argFolderPath & "\"
    End If
End Function

 

[Lost_in_Excel]

This is brilliant. just what I need. Thanks

 

[GWteB]

You are welcome and thanks for letting me know.