Determing close method with vba

JS

Hi,

How can I in vba code trap which closing method the usr has used. E.g. File -> Close, File -> Exit, workbook X or application X

Grateful for help.

Jonas

sjoo

i'm afraid this is what you're looking for.

you can trap a closing events of workbooks.

the event method is:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

...

End Sub

you can get the events at ThisWorkbook node of project explorer of VBE.

JS

Afraid

No that's not it. But workbookbeforeclose is the cause for my question. I need to now what the usr wants to close. If the usr press exit application X then I need to loop through all open wb to modify them and then close them each by each. On the other hand if the usr just wants to close one specific workbook I do not want the macro to loop through all open workbooks.

Regards

Jonas

Andy Pope

Hi,

I don't think you can tell the difference.

The way to handle this is with an appliction event, use a class to create this. Then as each workbook is closed you run any code you need for that particular workbook. No need to worry about the others as they will trigger their own workbook close event.
So if the application is close each open workbook should fire the event.

JS

It works fine when just one book is closed but when the application is closed the error 'Run time error '9' subscript out of range' occurs. The only way I figured to get around this problem was to create a For each wb loop. Which works but then it will loop through all worksbook also when only one workbook is supposed to be closed. That is why I asked for information regarding close method. But as you sad Andy and after asking in other forums recieving the same answer as yours I guess it is not possible.

Ahh I just got it to work. The problem was with the red marked below. Removing the Wb made it work! When the error occured it was that line which was highlighted.

Thanks!

Option Explicit
Option Base 1

Public WithEvents App As Application

Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)

Dim SecurityLevel()
Dim CurFoot
Dim Level As Integer
Dim ws As Worksheet
Dim fName

'For Each Wb In Application.Workbooks
'If Wb.Name = "PERSONAL.XLS" Then GoTo NextWb
'If Wb.Name = ThisWorkbook.Name Then GoTo NextWb
'If Wb.Saved = False And Not Wb.IsAddin Then
'If Wb.Name <> ThisWorkbook.Name Then

Level = 0

SecurityLevel = Array("Secret", "Confidential", "Proprietary", "Public")

CurFoot = Wb.Worksheets("Sheet1").PageSetup.LeftFooter

If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(1) & ">" Then Exit Sub
If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(2) & ">" Then Exit Sub
If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(3) & ">" Then Exit Sub
If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(4) & ">" Then Exit Sub

Do Until Level = 1 Or Level = 2 Or Level = 3 Or Level = 4
Level = Application.InputBox("Do you want to AFR secure '" & Wb.Name & "' " & " 1 = Secret, 2 = Confidential, " & Chr(10) & "3 = Proprietary and 4 = Public.", "AFR", 2, Type:=1)
If Level = 0 Then
Exit Sub
End if
Loop

'For Each ws In Worksheets
Wb.Worksheets("Sheet1").PageSetup.LeftFooter = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(Level) & ">"
'Next ws

'Next Wb

'Application.EnableEvents = True

End Sub

Andy Pope

Glad you managed to resolve the problem.
This version also added a check for the closure of Addin files, which will happen when the application is closed.

Code Snippet

Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)

Dim SecurityLevel()
Dim CurFoot
Dim Level As Integer
Dim ws As Worksheet
Dim fName

If Wb.IsAddin Then Exit Sub

Level = 0

SecurityLevel = Array("Secret", "Confidential", "Proprietary", "Public")

CurFoot = Wb.Worksheets("Sheet1").PageSetup.LeftFooter

If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(1) & ">" Then Exit Sub
If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(2) & ">" Then Exit Sub
If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(3) & ">" Then Exit Sub
If CurFoot = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(4) & ">" Then Exit Sub

Do Until Level = 1 Or Level = 2 Or Level = 3 Or Level = 4
Level = Application.InputBox("Do you want to AFR secure '" & Wb.Name & "' " & " 1 = Secret, 2 = Confidential, " & Chr(10) & "3 = Proprietary and 4 = Public.", "AFR", 2, Type:=1)
If Level = 0 Then
Exit Sub
End If
Loop

Wb.Worksheets("Sheet1").PageSetup.LeftFooter = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(Level) & ">"

End Sub