Thread: Save As Macro
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
SudokuKing SudokuKing is offline
external usenet poster
 
Posts: 1
Default Save As Macro


This code will perform the desired "save as" action. I'm not sure how
to auto-execute this macro, though. If you are opening multiple files,
you could modify this to loop through all the files after they've been
opened.

Sub SaveAsExcelWorkbook()

Dim fname As String

'Auto-generate a filename by changing the extension to ".xls"
If InStr(1, ActiveWorkbook.FullName, ".") < 0 Then
fname = Left(ActiveWorkbook.FullName, InStr(1,
ActiveWorkbook.FullName, ".") - 1) & ".xls"
Else: fname = ActiveWorkbook.FullName & ".xls"
End If

'Uncomment line below to display a "Save As" dialog box
'fname =
Application.GetSaveAsFilename(InitialFileName:=Lef t(ActiveWorkbook.Name,
InStr(1, ActiveWorkbook.Name, ".") - 1) & ".xls", fileFilter:="Excel
Workbook files (*.xls), *.xls")
If fname < "False" Then
'Save as excel Workbook.
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=fname,
FileFormat:=xlWorkbookNormal
If err.Number < 0 Then MsgBox "File was not saved"
On Error GoTo 0
End If
'Uncomment line below to automatically close the workbook.
'ActiveWorkbook.Close
End Sub


--
SudokuKing
------------------------------------------------------------------------
SudokuKing's Profile: http://www.excelforum.com/member.php...o&userid=35868
View this thread: http://www.excelforum.com/showthread...hreadid=556592