2003

Trying to understand an excellent procedure posted by Dave Petersen in
2005.

How do I test the flow of the code (variables etc)? When I run the
code by "saving" a file, the VBE window does not to appear to get
focus, nor can I pause the code.

Hopefully and most likely the answer is simple? The code is below.

As is, the code does not stop Excel from quering "Do you want to save
....." I would like to have the code intercept the XL standard queries
if possible. BTY, the code below is saved in an xla file which in turn
is "linked" as a XL Addin.

Also, the file is saves as .xlk which is not really a problem as I
assume that xlk is the default XL "Backup" file suffix (which would
explain where in the code the "k" came from).

TIA

Eagle One

************************************************** ***********

Option Explicit
Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub Workbook_Close()
Set xlApp = Nothing
End Sub
Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, _
ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim myFileName As Variant
Dim testStr As String
Dim resp As Long

myFileName = Wb.FullName

If SaveAsUI Then
myFileName = Application.GetSaveAsFilename _
(InitialFileName:=Wb.FullName, _
filefilter:="Excel file, *.xls")
If myFileName = False Then
Cancel = True
Exit Sub
Else
testStr = ""
On Error Resume Next
testStr = Dir(myFileName)
On Error GoTo 0

resp = vbYes
If testStr = "" Then
'do nothing
Else
resp = MsgBox(Prompt:="Overwrite Existing File?", _
Buttons:=vbYesNo)
If resp = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
End If

'do the actual save
With Application
.StatusBar = "Saving " & myFileName
.DisplayAlerts = False
.EnableEvents = False
End With

On Error Resume Next
Wb.SaveAs myFileName, FileFormat:=xlWorkbookNormal,
CreateBackup:=True
If Err.Number < 0 Then
MsgBox "Something went wrong. File not saved" & vbLf _
& Err.Number & "--" & Err.Description
Err.Clear
Else
MsgBox "Saved as an xl workbook as: " & myFileName
End If
With Application
.StatusBar = False
.DisplayAlerts = True
.EnableEvents = True
End With

Cancel = True 'we did the work, don't let excel do it again.

[I AM NOT SURE THAT THE ABOVE LINE IS WORKING AS IT STATES???]

End Sub

First, you put this code into the ThisWorkbook module, right?

And second, you enabled macros when you opened this workbook? If you just added
the code, the workbook_open event has to run. You can close and reopen or just
run that event manually.

Then you can insert a breakpoint on a line with in the workbookbeforesave event.

Then saving the file should cause the application event to fire and you should
be able to step through the code.

EagleOne wrote:

2003

Trying to understand an excellent procedure posted by Dave Petersen in
2005.

How do I test the flow of the code (variables etc)? When I run the
code by "saving" a file, the VBE window does not to appear to get
focus, nor can I pause the code.

Hopefully and most likely the answer is simple? The code is below.

As is, the code does not stop Excel from quering "Do you want to save
...." I would like to have the code intercept the XL standard queries
if possible. BTY, the code below is saved in an xla file which in turn
is "linked" as a XL Addin.

Also, the file is saves as .xlk which is not really a problem as I
assume that xlk is the default XL "Backup" file suffix (which would
explain where in the code the "k" came from).

TIA

Eagle One

************************************************** ***********

Option Explicit
Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub Workbook_Close()
Set xlApp = Nothing
End Sub
Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, _
ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim myFileName As Variant
Dim testStr As String
Dim resp As Long

myFileName = Wb.FullName

If SaveAsUI Then
myFileName = Application.GetSaveAsFilename _
(InitialFileName:=Wb.FullName, _
filefilter:="Excel file, *.xls")
If myFileName = False Then
Cancel = True
Exit Sub
Else
testStr = ""
On Error Resume Next
testStr = Dir(myFileName)
On Error GoTo 0

resp = vbYes
If testStr = "" Then
'do nothing
Else
resp = MsgBox(Prompt:="Overwrite Existing File?", _
Buttons:=vbYesNo)
If resp = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
End If

'do the actual save
With Application
.StatusBar = "Saving " & myFileName
.DisplayAlerts = False
.EnableEvents = False
End With

On Error Resume Next
Wb.SaveAs myFileName, FileFormat:=xlWorkbookNormal,
CreateBackup:=True
If Err.Number < 0 Then
MsgBox "Something went wrong. File not saved" & vbLf _
& Err.Number & "--" & Err.Description
Err.Clear
Else
MsgBox "Saved as an xl workbook as: " & myFileName
End If
With Application
.StatusBar = False
.DisplayAlerts = True
.EnableEvents = True
End With

Cancel = True 'we did the work, don't let excel do it again.

[I AM NOT SURE THAT THE ABOVE LINE IS WORKING AS IT STATES???]

End Sub

--

Dave Peterson

Thanks Dave,

Yes I did place the code in This Workbook. Buuuut I did not close and
re-open.


Dave Peterson wrote:
First, you put this code into the ThisWorkbook module, right?

And second, you enabled macros when you opened this workbook? If you just added
the code, the workbook_open event has to run. You can close and reopen or just
run that event manually.

Then you can insert a breakpoint on a line with in the workbookbeforesave event.

Then saving the file should cause the application event to fire and you should
be able to step through the code.

EagleOne wrote:

2003

Trying to understand an excellent procedure posted by Dave Petersen in
2005.

How do I test the flow of the code (variables etc)? When I run the
code by "saving" a file, the VBE window does not to appear to get
focus, nor can I pause the code.

Hopefully and most likely the answer is simple? The code is below.

As is, the code does not stop Excel from quering "Do you want to save
...." I would like to have the code intercept the XL standard queries
if possible. BTY, the code below is saved in an xla file which in turn
is "linked" as a XL Addin.

Also, the file is saves as .xlk which is not really a problem as I
assume that xlk is the default XL "Backup" file suffix (which would
explain where in the code the "k" came from).

TIA

Eagle One

************************************************** ***********

Option Explicit
Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub Workbook_Close()
Set xlApp = Nothing
End Sub
Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, _
ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim myFileName As Variant
Dim testStr As String
Dim resp As Long

myFileName = Wb.FullName

If SaveAsUI Then
myFileName = Application.GetSaveAsFilename _
(InitialFileName:=Wb.FullName, _
filefilter:="Excel file, *.xls")
If myFileName = False Then
Cancel = True
Exit Sub
Else
testStr = ""
On Error Resume Next
testStr = Dir(myFileName)
On Error GoTo 0

resp = vbYes
If testStr = "" Then
'do nothing
Else
resp = MsgBox(Prompt:="Overwrite Existing File?", _
Buttons:=vbYesNo)
If resp = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
End If

'do the actual save
With Application
.StatusBar = "Saving " & myFileName
.DisplayAlerts = False
.EnableEvents = False
End With

On Error Resume Next
Wb.SaveAs myFileName, FileFormat:=xlWorkbookNormal,
CreateBackup:=True
If Err.Number < 0 Then
MsgBox "Something went wrong. File not saved" & vbLf _
& Err.Number & "--" & Err.Description
Err.Clear
Else
MsgBox "Saved as an xl workbook as: " & myFileName
End If
With Application
.StatusBar = False
.DisplayAlerts = True
.EnableEvents = True
End With

Cancel = True 'we did the work, don't let excel do it again.

[I AM NOT SURE THAT THE ABOVE LINE IS WORKING AS IT STATES???]

End Sub

--

Dave Peterson

Some way that "Set xlApp = Application" line has to run--either by closing and
reopening or just manually rerunning.

And when you're testing, you may find that you kill the xlApp variable (maybe
hitting the reset button??). Just rerunning that workbook_open procedure will
be the easiest way to fix that problem.

EagleOne wrote:

Thanks Dave,

Yes I did place the code in This Workbook. Buuuut I did not close and
re-open.

Dave Peterson wrote:
First, you put this code into the ThisWorkbook module, right?

And second, you enabled macros when you opened this workbook? If you just added
the code, the workbook_open event has to run. You can close and reopen or just
run that event manually.

Then you can insert a breakpoint on a line with in the workbookbeforesave event.

Then saving the file should cause the application event to fire and you should
be able to step through the code.

EagleOne wrote:

2003

Trying to understand an excellent procedure posted by Dave Petersen in
2005.

How do I test the flow of the code (variables etc)? When I run the
code by "saving" a file, the VBE window does not to appear to get
focus, nor can I pause the code.

Hopefully and most likely the answer is simple? The code is below.

As is, the code does not stop Excel from quering "Do you want to save
...." I would like to have the code intercept the XL standard queries
if possible. BTY, the code below is saved in an xla file which in turn
is "linked" as a XL Addin.

Also, the file is saves as .xlk which is not really a problem as I
assume that xlk is the default XL "Backup" file suffix (which would
explain where in the code the "k" came from).

TIA

Eagle One

************************************************** ***********

Option Explicit
Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub Workbook_Close()
Set xlApp = Nothing
End Sub
Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, _
ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim myFileName As Variant
Dim testStr As String
Dim resp As Long

myFileName = Wb.FullName

If SaveAsUI Then
myFileName = Application.GetSaveAsFilename _
(InitialFileName:=Wb.FullName, _
filefilter:="Excel file, *.xls")
If myFileName = False Then
Cancel = True
Exit Sub
Else
testStr = ""
On Error Resume Next
testStr = Dir(myFileName)
On Error GoTo 0

resp = vbYes
If testStr = "" Then
'do nothing
Else
resp = MsgBox(Prompt:="Overwrite Existing File?", _
Buttons:=vbYesNo)
If resp = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
End If

'do the actual save
With Application
.StatusBar = "Saving " & myFileName
.DisplayAlerts = False
.EnableEvents = False
End With

On Error Resume Next
Wb.SaveAs myFileName, FileFormat:=xlWorkbookNormal,
CreateBackup:=True
If Err.Number < 0 Then
MsgBox "Something went wrong. File not saved" & vbLf _
& Err.Number & "--" & Err.Description
Err.Clear
Else
MsgBox "Saved as an xl workbook as: " & myFileName
End If
With Application
.StatusBar = False
.DisplayAlerts = True
.EnableEvents = True
End With

Cancel = True 'we did the work, don't let excel do it again.

[I AM NOT SURE THAT THE ABOVE LINE IS WORKING AS IT STATES???]

End Sub

--

Dave Peterson

--

Dave Peterson