Solved: "save as" subroutine and checking for saved status

[andrewvanmar]

I'd like to start a existing routing off with a a "save as" dialogue, if the document is not in saved status.

i think it would look something like this (i commented the parts I don't know how to write)


If ActiveWorkbook.Saved = False Then
'open save as command Then
'if the save as is canceled
Exit Sub
End If

Else
'go on with the routine

What this should accomplish, is that it checks if the document is in saved status or not, and if not, that it asks you to save first. if you cancel the save it will exit the whole routine. if the do save, or it's saved allready, then the routing goes on.

Any want to fill in the gaps?

[Bob Phillips]

Dim mpFilename As Variant

If Not ActiveWorkbook.Saved Then
mpFilename = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If mpFilename = False Then
Exit Sub
Else
ActiveWorkbook.SaveAs mpFilename
End If
Else
'go on with the routine
End If

[rbrhodes]

Hi andrew,

This should get you started:


Option Explicit
Sub routine()
'
'Written by rbrhodes July 31, 2007
'
'http://www.members,shaw.ca/ExcelVBA
'
'Checks if file is saved. SaveAs if not else continues
'
Dim wb As Workbook
Dim fname As String

Set wb = ActiveWorkbook

With wb
'first check if never been saved, then check if changes have been saved
'NOTE: new file has saved = true but path is 0 length ie: ""

If .Path = "" Or .Saved = False Then

fname = Application.GetSaveAsFilename

If InStr(fname, "False") = 0 Then

'UnComment to turn off warning, Uncomment restore line as well
'Application.DisplayAlerts = False

If UCase(Right(fname, 4)) <> ".XLS" Then
'possible ".xls" required
.SaveAs fname & "xls"
Else
.SaveAs fname
End If

'Restore warnings
'Application.DisplayAlerts = True

Else
'bail
Exit Sub
End If
End If
End With



'go on with the routine

'clean up
Set wb = Nothing
End Sub

[andrewvanmar]

If Not ActiveWorkbook.Saved Then
mpFilename = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If mpFilename = False Then
Exit Sub
Else
ActiveWorkbook.SaveAs mpFilename

'go on with the routine
End if
End if

Cool, that works!

I hit a snag, something I expected: if the workbook is in saved status, it skips the rest of the original routine. it because the end if's are at the end of the original routine.
but... if they are set at the end of the sub, then it skips the original routine when the save as is called.
removing the else and placing both end if's at the end of the sub seems to work
Dim mpFilename As Variant

If Not ActiveWorkbook.Saved Then
mpFilename = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If mpFilename = False Then
Exit Sub
Else
ActiveWorkbook.SaveAs mpFilename

'go on with the routine
End If
End If

[andrewvanmar]

Thanks XLD!

Rhodes, trying to figure out your version: what is the commented "warning" ?

[rbrhodes]

Hi andrew,

My version incorporates a bit for a brand new workbook. A brand new workbook has a Saved status of True (although it's actually false) as the Saved property is dependent on changes being made. However it's Path property is blank so my version checks that as well.

The 'warnings' is whether you want the "File already exists!" dialog to display or not. If you Uncomment the two lines I marked the Dialog will not be displayed and the file will be overwritten without the dialog box ever showing.

ie:


'Temporarily turn off "File Exists!" warning
Application.DisplayAlerts = False

If UCase(Right(fname, 4)) <> ".XLS" Then
'possible ".xls" required
.SaveAs fname & "xls"
Else
.SaveAs fname
End If

'Restore warnings
Application.DisplayAlerts = True

[andrewvanmar]

rhodes,

thanks for the explanation.
I'll keep your code for a future project, i allready know where it'll come in handy. (i allready implemented xld's code, which works, and does what I require)