![]() |
If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
![]()
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 ¬ 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 ¬ save").Index 0 Then myPos = myBar.Controls("Send ¬ save").Index If myPos = 0 Then myPos = 3 msgVraag = MsgBox("The button 'Send &and save' or 'Send ¬ 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 ¬ 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 |
Ads |
#2
|
|||
|
|||
![]() 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: 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 ¬ 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 ¬ save").Index 0 Then myPos = myBar.Controls("Send ¬ save").Index If myPos = 0 Then myPos = 3 msgVraag = MsgBox("The button 'Send &and save' or 'Send ¬ 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 ¬ 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 |
#3
|
|||
|
|||
![]()
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 Michael Bauer [MVP - Outlook] wrote: 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: 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 ¬ 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 ¬ save").Index 0 Then myPos = myBar.Controls("Send ¬ save").Index If myPos = 0 Then myPos = 3 msgVraag = MsgBox("The button 'Send &and save' or 'Send ¬ 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 ¬ 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 |
#4
|
|||
|
|||
![]()
Well folks, just around the corner on
http://groups.google.nl/group/micros...611facd3b647cc 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 BartH_NL wrote: 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 Michael Bauer [MVP - Outlook] wrote: 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: 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 ¬ 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 ¬ save").Index 0 Then myPos = myBar.Controls("Send ¬ save").Index If myPos = 0 Then myPos = 3 msgVraag = MsgBox("The button 'Send &and save' or 'Send ¬ 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 ¬ 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Outlook 2003 will close but not shutdown | bobhat@hotmail.com | Outlook - General Queries | 1 | June 6th 06 10:42 PM |
outlook shutdown | glennscherrer@gmail.com | Outlook - General Queries | 1 | April 26th 06 03:06 AM |
Outlook Message Count - VBA Error - Multiple Inboxes | Ryan | Outlook and VBA | 3 | February 15th 06 11:35 PM |
Outlook XP Auto-shutdown Error | Cerulean | Outlook - General Queries | 0 | February 9th 06 05:49 AM |
Outlook Shutdown - command line | Pete | Outlook - Installation | 1 | February 7th 06 09:28 PM |