Hello all
My Company recently upgraded us from Office 2010 (I believe) to 2013 and a macro that I had used for years in Outlook is having issues in the new Outlook 2013. The macro served a fairly basic function, when I go to send an email, it prompted me if I "really wanted to send it" with an option to continue or not continue. Then it would pull up the folder hierarchy so that I could file my response in the appropriate folder. I had this functionality in Lotus Notes back in the day and was surprised when I transitioned to Outlook that it was not there.
The main issue that I am having with using the macro in Outlook 2013 is that previously, when the folder selection popped up, if I hit escape, the response would be filed in the Sent Items folder by default. If I do that in Outlook 2013, it crashes outlook and it has to be restarted.
I am not a coder, so trying to "debug" the macro is leading me nowhere. Does anyone have a clue what is going wrong?
Here is what I pulled from VBA in Outlook:
Option Explicit
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Private Sub Application_Startup()
Set objInspectors = Application.Inspectors
End Sub
Private Sub Application_Quit()
Set objInspectors = Nothing
Set objMyNewMail = Nothing
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class <> olMail Then Exit Sub
Set objMyNewMail = Inspector.CurrentItem
End Sub
Private Sub objMyNewMail_Send(Cancel As Boolean)
If MsgBox("Are you sure you want to send this message?", vbYesNo + vbQuestion _
, "SEND CONFIRMATION") = vbNo Then
Cancel = True
End If
End Sub
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
On Error Resume Next
Set objNS = Application.Session
If Item.Class = olMail Then
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing And _
IsInDefaultStore(objFolder) And _
objFolder.DefaultItemType = olMailItem Then
Set Item.SaveSentMessageFolder = objFolder
Else
Set objFolder = _
objNS.GetDefaultFolder(olFolderSentMail)
Set Item.SaveSentMessageFolder = objFolder
End If
End If
Set objFolder = Nothing
Set objNS = Nothing
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
Dim blnBadObject As Boolean
On Error Resume Next
Set objApp = objOL.Application
If Err = 0 Then
Set objNS = objApp.Session
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Select Case objOL.Class
Case olFolder
If objOL.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
Else
IsInDefaultStore = False
End If
Case olAppointment, olContact, olDistributionList, _
olJournal, olMail, olNote, olPost, olTask
If objOL.Parent.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
Else
IsInDefaultStore = False
End If
Case Else
blnBadObject = True
End Select
Else
blnBadObject = True
End If
If blnBadObject Then
MsgBox "This function isn't designed to work " & _
"with " & TypeName(objOL) & _
" objects and will return False.", _
, "IsInDefaultStore"
IsInDefaultStore = False
End If
Set objApp = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function
Bookmarks