Saving a timestamped file?

[welshgasman]

Hi all,


I have some code as shown below, that allows me to regularly save an excel workbook with dates and time quickly.
The code works fine if the code is in each workbook, however I can see that it might be enhanced in the future and do not really want multiple copies in all my sheets.
So I pasted the code to my personal.xlsb and call it with

Application.Run "Personal.xlsb!BackupFile" ', ActiveWorkbook.FullName

Before doing this I had to use in the local sub

Application.Run "Personal.xlsb!Update_Display", "0"

as the Update_Display code was also in my Personal.xlsb

Sub Update_Display(bSwitch As Boolean)
    Application.ScreenUpdating = bSwitch
    Application.EnableEvents = bSwitch
    Application.DisplayAlerts = bSwitch
End Sub

When I try calling the code in the Personal.xlsb I get error display 1004,stating 'File cannot be saved with the selected file type'

If I run it from the file itself, it works fine, so I *think* it is trying to save Personal.xlsb perhaps as an xlsm file? (not what I want anyway)

So how can I create a generic savefile routine to be called from anywhere?

Also this rasies a problem whereby, how do I code it so that another user could use the code?
Would I have to put an xlsb in some common location and refer explicitly to the path when using Application.Run method?

TIA

Sub BackupFile(Optional pstrFile As String)
Dim strPfxDate As String, strPfxTime As String, strFullPath As String, strBackupPath As String, strWBname As String
Dim blnAlert As Boolean
' if no file supplied to program, use active workbook
    If pstrFile = "" Then
        pstrFile = ActiveWorkbook.FullName
    End If
    Update_Display (0)
    
' Now get the parameters for the filename




    strPfxDate = Format(Now(), "yyyymmdd")
    strPfxTime = Format(Now(), "hhmmss")
    strFullPath = Left(pstrFile, InStrRev(ActiveWorkbook.FullName, "\"))
    strWBname = Right(pstrFile, Len(pstrFile) - InStrRev(ActiveWorkbook.FullName, "\"))
    strBackupPath = strFullPath & "Backup\"
    ' If backup path does not exist, create it
    If Dir(strBackupPath, vbDirectory) = "" Then
        MkDir strBackupPath
    End If
    ' Switch off alerts if on
    
    'Save the file
    Application.StatusBar = "Saving Date and Timestamped file"
    ThisWorkbook.SaveAs Filename:=strBackupPath & strPfxDate & "_" & strPfxTime & "_" & strWBname
    Application.StatusBar = "Saving again as normal name"
    ThisWorkbook.SaveAs Filename:=strFullPath & strWBname
    Application.StatusBar = False
    Update_Display (1)
End Sub