Run-time error 1004 Method SaveAS of object _Workbook failed
 

First...many THANKS to Ron DeBruin for the code to save a sheet using 2007 in
2003 format. It solved a previous issue I had posted.
However, using Ron's code, if a name already exists a message will come up
asking if I want to replace the exisitng file. If I click No or Cancel, I get
the Run Time error at this line of the code:
..SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

Here is the whole code, MUCH of which is Ron's! THANKS RON!!
Sub SaveMWJCAsR()

'Revised 12-17-08 to force version to run in Excel 2007 but save in 2003
..xls format
'Got from http://www.rondebruin.nl/saveas.htm

'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim MyDirectory As String
Dim JNum As String
Dim wsoutput As Worksheet

'Checks to See If A Directory Exists, If Not, Creates It
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just to make sure it is there
End If

'Set the Directory Here!
ChDir MyDirectory

DefPath = MyDirectory

If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

If Sheet96.Range("E5") < "" Then
JNum = Sheet96.Range("E5")
Else
End If

Range("A1").Activate
ActiveWorkbook.Colors(53) = RGB(247, 252, 255)
Range("A1").Select

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog
that you
'only see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
'Inserted below to force 2003 .xls file
FileExtStr = ".xls": FileFormatNum = 56
End If
End If
End With

'Save the new workbook and close it
'The Path is Set Above
'TempFilePath = Application.DefaultFilePath & "\"

'Determine File Name
If Range("H42") = 0 Then
TempFileName = "Job " & JNum
Else
TempFileName = "Job " & JNum & "C"
End If

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With

ChDir CurDir & "\.."

With Application
.ScreenUpdating = True
.EnableEvents = True
End With



End Sub

Run-time error 1004 Method SaveAS of object _Workbook failed
 

Hi

This check if the file exists before trying to SaveAs. If file exists
display warning and exit withour saving.

Sub Delete_Zero_Columns()
Dim NumCols As Integer, i As Integer
Dim StartCol As Range, ColArray As Range
Set StartCol = Range("C3")
NumCols = WorksheetFunction.CountA(Range("C3",
Range("C3").End(xlToRight)))


For i = 0 To NumCols - 1
If WorksheetFunction.Sum(StartCol.Offset(0, i).EntireColumn) = 0 Then
If ColArray Is Nothing Then
Set ColArray = StartCol.Offset(0, i).EntireColumn
Else
Set ColArray = Union(ColArray, StartCol.Offset(0, i).EntireColumn)
End If
End If
Next i
ColArray.Delete
End Sub

Sub SortSheets()
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
Columns("A:H").Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next
Application.ScreenUpdating = True
End Sub
Sub SaveMWJCAsR()

'Revised 12-17-08 to force version to run in Excel 2007 but save in 2003
..xls Format
'Got from http://www.rondebruin.nl/saveas.htm

'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim MyDirectory As String
Dim JNum As String
Dim wsoutput As Worksheet

'Checks to See If A Directory Exists, If Not, Creates It
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just to make sure it is there
End If

'Set the Directory Here!
ChDir MyDirectory

DefPath = MyDirectory

If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

If Sheet96.Range("E5") < "" Then
JNum = Sheet96.Range("E5")
Else
End If

Range("A1").Activate
ActiveWorkbook.Colors(53) = RGB(247, 252, 255)
Range("A1").Select

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialogthat you
'only see when you copy a sheet from a xlsm file with
macro'sdisabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
'Inserted below to force 2003 .xls file
FileExtStr = ".xls": FileFormatNum = 56
End If
End If
End With

'Save the new workbook and close it
'The Path is Set Above
'TempFilePath = Application.DefaultFilePath & "\"

'Determine File Name
If Range("H42") = 0 Then
TempFileName = "Job " & JNum
Else
TempFileName = "Job " & JNum & "C"
End If

'Check if file exists
fExists = Dir(TempFilePath & TempFileName & FileExtStr)
If fExists < "" Then
msg = MsgBox("The file has already been saved as: " & TempFileName &
_
FileExtStr & vbLf & vbLf & "Exit without saving file!", _
vbExclamation, "Warning !")
GoTo ExitWithoutSaving
End If

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With

ExitWithoutSaving:
ChDir CurDir & "\.."

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

Regards,
Per

"David" skrev i meddelelsen
...
First...many THANKS to Ron DeBruin for the code to save a sheet using 2007
in
2003 format. It solved a previous issue I had posted.
However, using Ron's code, if a name already exists a message will come up
asking if I want to replace the exisitng file. If I click No or Cancel, I
get
the Run Time error at this line of the code:
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum

Here is the whole code, MUCH of which is Ron's! THANKS RON!!
Sub SaveMWJCAsR()

'Revised 12-17-08 to force version to run in Excel 2007 but save in 2003
.xls format
'Got from http://www.rondebruin.nl/saveas.htm

'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim MyDirectory As String
Dim JNum As String
Dim wsoutput As Worksheet

'Checks to See If A Directory Exists, If Not, Creates It
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just to make sure it is there
End If

'Set the Directory Here!
ChDir MyDirectory

DefPath = MyDirectory

If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

If Sheet96.Range("E5") < "" Then
JNum = Sheet96.Range("E5")
Else
End If

Range("A1").Activate
ActiveWorkbook.Colors(53) = RGB(247, 252, 255)
Range("A1").Select

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog
that you
'only see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
'Inserted below to force 2003 .xls file
FileExtStr = ".xls": FileFormatNum = 56
End If
End If
End With

'Save the new workbook and close it
'The Path is Set Above
'TempFilePath = Application.DefaultFilePath & "\"

'Determine File Name
If Range("H42") = 0 Then
TempFileName = "Job " & JNum
Else
TempFileName = "Job " & JNum & "C"
End If

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With

ChDir CurDir & "\.."

With Application
.ScreenUpdating = True
.EnableEvents = True
End With



End Sub

Run-time error 1004 Method SaveAS of object _Workbook failed
 

Hi david

You can add the date/time to the file name

You can always replace the file if you want

What do you want to do ?


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"David" wrote in message ...
First...many THANKS to Ron DeBruin for the code to save a sheet using 2007 in
2003 format. It solved a previous issue I had posted.
However, using Ron's code, if a name already exists a message will come up
asking if I want to replace the exisitng file. If I click No or Cancel, I get
the Run Time error at this line of the code:
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

Here is the whole code, MUCH of which is Ron's! THANKS RON!!
Sub SaveMWJCAsR()

'Revised 12-17-08 to force version to run in Excel 2007 but save in 2003
.xls format
'Got from http://www.rondebruin.nl/saveas.htm

'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim MyDirectory As String
Dim JNum As String
Dim wsoutput As Worksheet

'Checks to See If A Directory Exists, If Not, Creates It
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just to make sure it is there
End If

'Set the Directory Here!
ChDir MyDirectory

DefPath = MyDirectory

If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

If Sheet96.Range("E5") < "" Then
JNum = Sheet96.Range("E5")
Else
End If

Range("A1").Activate
ActiveWorkbook.Colors(53) = RGB(247, 252, 255)
Range("A1").Select

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog
that you
'only see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
'Inserted below to force 2003 .xls file
FileExtStr = ".xls": FileFormatNum = 56
End If
End If
End With

'Save the new workbook and close it
'The Path is Set Above
'TempFilePath = Application.DefaultFilePath & "\"

'Determine File Name
If Range("H42") = 0 Then
TempFileName = "Job " & JNum
Else
TempFileName = "Job " & JNum & "C"
End If

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With

ChDir CurDir & "\.."

With Application
.ScreenUpdating = True
.EnableEvents = True
End With



End Sub