Thread: Macro that forces user to save file on open

I need to crate a macro that will force the user to save the file as a different name when they open the file
I have this code and it works. I just need to have it run when the file is opened. Is there an on open function that I can add to make it do this?

Sub FS()
'fileSaveName = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")
fileSavename = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
'If user specified file name, perform Save and display msgbox

If fileSavename <> False Then
pointPos = InStrRev(fileSavename, ".")
fileSavename = Left(fileSavename, pointPos - 1) & Mid(fileSavename, pointPos)
ActiveWorkbook.SaveAs Filename:=fileSavename, FileFormat:=xlNormal

MsgBox "Save As " & fileSavename
End If

End Sub

Thanks a bunch.

you can use the open procudure. " put this is ths workbook section"

Code:

Private Sub Workbook_Open()

End Sub

Aternalty to force the user to save to a directory of your choosing can be done like.

Code:

Sub just4you()
Dim strName As String

strName = InputBox(Prompt:="You name please.", _
          Title:="ENTER YOUR NAME", Default:="Your Name here")
If strName = "" Then strName = "choose a name"

ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\1 1\Desktop\" & strName, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

hope that helps.

So if you paste your code in the workbook_Open module it will run everytime the book is opened.

This is found in a section above the macro modules called 'ThisWorkbook' From there paste this in and it should work fine.

Code:

Private Sub Workbook_Open()
    'fileSaveName = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")
    fileSavename = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")
    'If user specified file name, perform Save and display msgbox
    
    If fileSavename <> False Then
    pointPos = InStrRev(fileSavename, ".")
    fileSavename = Left(fileSavename, pointPos - 1) & Mid(fileSavename, pointPos)
    ActiveWorkbook.SaveAs Filename:=fileSavename, FileFormat:=xlNormal
    
    MsgBox "Save As " & fileSavename
    End If
End Sub