never ending loop
I have fixed it so don't waste any time on this.
Hi,
I have a code that is supposed to loop through all open workbooks to perform some action. But for some reason my for each loop never ends. Anyone out there who sees what I have missed? The code is like below,
ThisWorkbbok:
Option Explicit
Dim AppClass As New EventClass
Private Sub Workbook_Open()
Set AppClass.App = Application
End Sub
VBA module:
Option Explicit
Public AppClass As EventClass
Class module:
Option Explicit
Option Base 1
Public WithEvents App As Application
Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
'On Error GoTo ErrorHandler
Dim SecurityLevel()
Dim CurFoot
Dim Level As Integer
Dim ws As Worksheet
For Each Wb In Application.Workbooks '''THIS NEVER ENDS
If Wb.Saved = False And Not Wb.IsAddin And Not Wb.Name = "PERSONAL.XLS" Then
Wb.Activate
If IsEmpty(ActiveSheet.UsedRange) Then
Wb.Close
GoTo NextWb
End If
MsgBox Wb.Name
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
'On Error Resume Next
Do Until Level = 1 Or Level = 2 Or Level = 3 Or Level = 4
Level = Application.InputBox("To AFR secure this document type in security level, otherwise cancel. 1 = Secret, 2 = Confidential, " & Chr(10) & "3 = Proprietary and 4 = Public.", "Security Level", 2, Type:=1)
If Level = 0 Then
GoTo NextWb ''' Cancel pressed
End If
Loop
For Each ws In Worksheets
ws.PageSetup.LeftFooter = Application.UserName & ", " & Format(Date, "yyyy-mm-dd") & Chr(10) & "Security Class <" & SecurityLevel(Level) & ">"
Next ws
End If
NextWb:
Next Wb
'ErrorHandler:
''' End sub
End Sub
Thankful for help.
Jonas
