Hi all,
first of all, apologies if i have posted this in an incorrect location... i didn't find a section for outlook and since my questions are VBA based, i thought this would be the most appropriate place for them.
now, i have some code below which i got from an my old boss which is potentially great, but i think it needs a couple of minor tweaks. the code works like this:
every time an email is sent, a pop-up box appears showing all the mail folders. the user then chooses where the email just sent is to be stored and clicks ok. The user also has the option to create a new folder for the email.
the idea is great and the code works pretty well, however i believe there are 2 things which could improve this greatly:
1) if the user chooses the "OK" or the "New Folder" option, there are no problems. However if the user presses "Cancel" the code returns an error and crashes, causing outlook to crash.
2) the default location (the highlighted folder when the pop-up first appears) for storing the email which is about to be sent is the Inbox.
Can someone please help me resolve the two bugs? i would like the code to do the following for the above situations:
1) if the user chooses "Cancel", the email is to be stored in the "Sent Items" folder.
2) The default location for the emails (when the pop-up first appears) should be the "Sent Items" folder.
help would be greatly appreciated!
Code is as follows (just paste it into ThisOutlookSession)
Private Sub Application_ItemSend(ByVal Item As Object, _
<wbr> 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(<wbr>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 ob***p As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim blnBadObject As Boolean
On Error Resume Next
Set ob***p = objOL.Application
If Err = 0 Then
Set objNS = ob***p.Session
Set objInbox = objNS.GetDefaultFolder(<wbr>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 ob***p = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function
first of all, apologies if i have posted this in an incorrect location... i didn't find a section for outlook and since my questions are VBA based, i thought this would be the most appropriate place for them.
now, i have some code below which i got from an my old boss which is potentially great, but i think it needs a couple of minor tweaks. the code works like this:
every time an email is sent, a pop-up box appears showing all the mail folders. the user then chooses where the email just sent is to be stored and clicks ok. The user also has the option to create a new folder for the email.
the idea is great and the code works pretty well, however i believe there are 2 things which could improve this greatly:
1) if the user chooses the "OK" or the "New Folder" option, there are no problems. However if the user presses "Cancel" the code returns an error and crashes, causing outlook to crash.
2) the default location (the highlighted folder when the pop-up first appears) for storing the email which is about to be sent is the Inbox.
Can someone please help me resolve the two bugs? i would like the code to do the following for the above situations:
1) if the user chooses "Cancel", the email is to be stored in the "Sent Items" folder.
2) The default location for the emails (when the pop-up first appears) should be the "Sent Items" folder.
help would be greatly appreciated!
Code is as follows (just paste it into ThisOutlookSession)
Private Sub Application_ItemSend(ByVal Item As Object, _
<wbr> 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(<wbr>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 ob***p As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim blnBadObject As Boolean
On Error Resume Next
Set ob***p = objOL.Application
If Err = 0 Then
Set objNS = ob***p.Session
Set objInbox = objNS.GetDefaultFolder(<wbr>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 ob***p = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function
