Try code like the following. Change the value of FName to the inital
filename.
Sub DoSaveAs()
Dim FName As Variant
Dim Ext As String
Dim N As Long
Dim FileFormat As XlFileFormat
Dim Ndx As Long
FName = ThisWorkbook.FullName
N = InStrRev(FName, ".")
Ext = Mid(FName, N + 1)
Select Case LCase(Ext)
Case "xls": Ndx = 1
Case "xlsm": Ndx = 2
Case "xlsx": Ndx = 3
Case "xlsb": Ndx = 4
End Select
FName = Application.GetSaveAsFilename(FName, _
"Excel Files (*.xls),*.xls," & _
"Excel Files (*.xlsm),*.xlsm," & _
"Excel Files (*.xlsx),*.xlsx," & _
"Excel Files (*.xlsb),*.xlsb", _
Ndx)
If FName = False Then
' user cancelled. get out.
Exit Sub
End If
N = InStrRev(FName, ".")
Ext = Mid(FName, N + 1)
Select Case LCase(Ext)
Case "xls": FileFormat = xlExcel8
Case "xlsx": FileFormat = xlWorkbookDefault
Case "xlsb": FileFormat = xlExcel12
Case "xlsm": FileFormat = xlOpenXMLWorkbookMacroEnabled
End Select
On Error Resume Next
If StrComp(FName, ThisWorkbook.FullName, vbTextCompare) < 0 Then
Kill FName
End If
On Error GoTo 0
ThisWorkbook.SaveAs Filename:=FName, FileFormat:=FileFormat
End Sub
Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
On Thu, 31 Dec 2009 20:25:01 -0800, Brian
wrote:
I pasted this code in my User Form to assign the Name & Save a Workbook as
varibles from different Text Boxes. For some reason it assigns the name
correctly, but when you click on the save in the Save As Dialog box, only the
Error Message pops up and the Workbookbook does not save.
What am I missing?
'Save Engineering Spec 11 Control Button
Private Sub Save_Eng_Spec_11_Click()
Dim strFile As String
Dim bk As Workbook
strFile = "SPEC " & TEO_No_1.Value _
& Space(1) & CLLI_Code_1.Value _
& Space(1) & CES_No_1.Value _
& Space(1) & TEO_Appx_No_2.Value
strFile = Application.GetSaveAsFilename( _
InitialFileName:=strFile, _
fileFilter:="Excel Files (*.xls;*.xlsm;*.xlst), " & _
"*.xls;*.xlsm;*.xlst")
If FileToSave = False Then
MsgBox "The Save Method Failed, Eng Spec was not Saved", , "C.E.S."
Exit Sub
End If
End Sub