VBA shutdown error Outlook

[BartH_NL]

Hello, like so many code cats before me I now have a persistant
shutdown error in my Outlook VBA code. I do know I have to clean up my
object declarations and have a lot of cleaning going on but stil can't
find the error. Maybe somebody is more awake that I? (Isn't there an
code cleaner / debugger app?)

The code is meant to add an on/off commandbarbutton to a Send and File
script.

Here is the code:

Public myFlag As Boolean
Public myPos As Integer
Dim myolapp As Outlook.Application
Dim myInspector As Outlook.Inspector
Dim myExplorer As Outlook.Explorer
Dim myBar As CommandBar
Dim myButton As CommandBarButton

Sub installSendAndFile()

On Error Resume Next
Set myolapp = CreateObject("Outlook.Application")
Set myInspector = myolapp.ActiveInspector
Set myBar = myInspector.CommandBars("Standard")

If myInspector Is Nothing Then
MsgBox "Please activate a 'New message' window and run this macro
again.", vbExclamation, "Not ready"
Exit Sub
End If

If myBar.Controls("Send &and save").Index > 0 Then myPos =
myBar.Controls("&Send and save").Index
If myBar.Controls("Send &not save").Index > 0 Then myPos =
myBar.Controls("&Send not save").Index

If myPos = 0 Then
Set myButton = myBar.Controls _
.Add(msoControlButton, , , 3)
With myBar.Controls(3)
.OnAction = "Project1.ThisOutlookSession.setFlag"
.FaceId = 7267
.Style = msoButtonIconAndCaption
End With
setFlag
Else
MsgBox "The button '" & myBar.Controls(MyPos).Caption & "' alread
exists."
End If

' CLEAN-UP

exitHandler

End Sub

Sub setFlag()

On Error Resume Next
Set myolapp = CreateObject("Outlook.Application")
Set myInspector = myolapp.ActiveInspector
Set myBar = myInspector.CommandBars("Standard")

If myBar.Controls("Send &and save").Index > 0 Then myPos =
myBar.Controls("Send &and save").Index
If myBar.Controls("Send &not save").Index > 0 Then myPos =
myBar.Controls("Send &not save").Index
If myPos = 0 Then
myPos = 3
msgVraag = MsgBox("The button 'Send &and save' or 'Send &not
save' seems not to exist." & vbCr & "Is this the button on position " &
myPos & "?", vbYesNo)
End If
If msgVraag = vbNo Then
MsgBox "Because of an unexpected event this procedure is ended." &
vbLf & "Please contact the programmer or remove and reinstall the
commandbarbutton."
Exit Sub
End If

If myFlag = True Then

myFlag = False

With myBar.Controls(MyPos)
.FaceId = 2617
.TooltipText = "Send and save is OFF," & vbLf & "click to
ENABLE save the file to a folder"
.Caption = "Send &and save"
End With

Else

myFlag = True

With myBar.Controls(MyPos)
.FaceId = 7267
.TooltipText = "Send and save is ON," & vbLf & "click to
DISABLE save the file to a folder"
.Caption = "Send &not save"
End With

End If

' CLEAN-UP

exitHandler

End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As
Boolean)

On Error Resume Next
' Check for myFlag state to enable or disable Send and File
If myFlag = False Then Exit Sub

If Item.Class < 50 Then ' check to see if item type is appointment, if
so don't file
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) <> "Nothing" And _
IsInDefaultStore(objFolder) Then
Set Item.SaveSentMessageFolder = objFolder
End If
Set objFolder = Nothing
Set objNS = Nothing
End If

' CLEAN-UP

exitHandler

End Sub

Public Function IsInDefaultStore(objOL As Object) As Boolean
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder

On Error Resume Next
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Select Case objOL.Class
Case olFolder
If objOL.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case olAppointment, olContact, olDistributionList, _
olJournal, olMail, olNote, olPost, olTask
If objOL.Parent.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case Else
MsgBox "This function isn't designed to work " & _
"with " & TypeName(objOL) & _
" items and will return False.", _
, "IsInDefaultStore"
End Select

' CLEAN-UP

exitHandler

End Function

Public Sub exitHandler()

On Error Resume Next

Set myolapp = Nothing
Set myExplorer = Nothing
Set myInspector = Nothing
Set myBar = Nothing
Set myButton = Nothing
Set objApp = Nothing
Set objNS = Nothing
Set objInbox = Nothing

End Sub

Private Sub Application_Quit()
' CLEAN-UP
exitHandler
End Sub

Private Sub Application_Startup()
myFlag = True
End Sub

Thanks,
BartH

 

[Michael Bauer [MVP - Outlook]]

What is the error and where does it occur?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --

Am 15 Nov 2006 14:23:17 -0800 schrieb BartH_NL:

 

[BartH_NL]

Hello Michael,

The error occurs at Outlook shutdown after I have sent a new message or
after I hit the button. When I change nothing and I send no e-mail, the
error does not occur. The error message pops up about 8 seconds after
Outlook is shut down. To see the message, check
http://www.nedcom.nl/images/outlook_error.jpg.

When I reopen Outlook, I get a message that a severe VBA error has
occured and I am invited to disable the code. Check
http://www.nedcom.nl/images/startup_message.jpg.

(These messages are in Dutch, but I guess you'll be able to make
something of them.)

Regards,
BartH

 

[BartH_NL]

Well folks, just around the corner on

http://groups.google.nl/group/micro.../2d2efba271f5130b?hl=en&#doc_b2611facd3b647cc

Ken Slovak gave me some useful commentary. I've solved the problem
mainly by removing the Sub
Application_Quit exitHandler. I simply cleaned up one time too much.

Regards and thanks for thinking with me.

BartH