asked on

Saving a File Under a New Name

Hi, I'm writing a macro that will save a file under a new name. I will need it to give the user an option to choose the name and the location to save the file.

I have the following code: A Syntax Error message appears and I'm not sure how to fix this.

Sub Save_File()
'
' Save_File Macro
 
 
    Dim ActSheet As Worksheet
 
    Dim ActBook As Workbook
 
    Dim CurrentFile As String
 
    Dim NewFileType As String
 
    Dim NewFile As String
 
 
    Application.ScreenUpdating = False    ' Prevents screen refreshing.
 
 
    CurrentFile = ThisWorkbook.FullName
 
[b] 
    NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _

               "Excel Files 2007 (*.xlsx), *.xlsx," & _

               "All files (*.*), *.*"[/b]
 
 
 
    [b]NewFile = Application.GetSaveAsFilename( _

        InitialFileName:=NewFileName, _

        fileFilter:=NewFileType)[/b]
 
 
 
    If NewFile <> "" And NewFile <> "False" Then
 
       [b] ActiveWorkbook.SaveAs Filename:= NewFile, _

            FileFormat:=xlOpenXMLWorkbookMacroEnabled, _

            ReadOnlyRecommended:=False, _

            CreateBackup:=False
     
[/b]
 
        Set ActBook = ActiveWorkbook
 
        Workbooks.Open CurrentFile
 
        ActBook.Close
 
    End If
 
 
 
    Application.ScreenUpdating = True
 
End Sub

Open in new window

Steven Harris

I would suggest using something a bit less complicated to start with:

Application.GetSaveAsFileName

Open in new window

You can save this to a variable:

Dim NewName As String
NewName = Application.GetSaveAsFilename

Open in new window

And then run whatever validation you want against "NewName"

Sub Save_File()
Dim NewFile As String
Dim CurrentFile As String
NewFile = Application.GetSaveAsFilename
CurrentFile = ThisWorkbook.FullName
    Application.ScreenUpdating = False

    If NewFile <> "" Then
        ActiveWorkbook.SaveAs NewFile & "xlsm"
        Set ActBook = ActiveWorkbook
        CurrentFile.Open
        ActBook.Close
    End If
    
    Application.ScreenUpdating = True

End Sub

Open in new window

Edited: Fixed my script error

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial