E
EagleOne
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
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