How do I 'Save Copy of Sent Item to Folder' for a Shared Mailbox

[Rob Vega]

Hi all,

Firstly, as this is my first post (avid lurker), salutations to all!

I love this forum, it's provided me with many solutions and ideas, so thank you to all, regardless if my question is answered or not, you are all awesome.

My problem:
After doing much research on the Save Sent Item To (for shared mailboxes), I've now understand that the option is greyed out due to the change in the registry (DelegateSentItemsStyle). This enables the shared inbox to save sent messages to the shared inbox sent folder.

A work around for this was to have the Save Sent Item folder to prompt when an email is sent (using the below code).

However, I want the prompt to only display when the user is sending from a specific email address. I've attempted to use < If SenderEmailAddress = 'email@address.com' Then >however, this never triggers, no matter what I try.

Could anyone offer assistance with the below code (extracted from http://www.outlookcode.com/article.aspx?id=48)

Private Sub Application_ItemSend(ByVal Item As Object, _
    Cancel As Boolean)
  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 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
  Set objApp = Nothing
  Set objNS = Nothing
  Set objInbox = Nothing
End Function

 

[Forum Admin]

Try using .SentOnBehalfOfName instead of senderemailaddress in your if statement.

 

[Rob Vega]

OMG Thank you, you know I tinkered with SentOnBehalfOfName heaps... but never used Item.SentOnBehalfOfName
(don't ask me why).

It worked and for those who might need it, here is the code (be kind I'm still a newbie )

'SavenSend

Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim msg As MailItem
Dim Sender As MailItem


If Item.SentOnBehalfOfName = "Name of Shared Inbox" Then 'Added this line

If Item.Class = olMail Then 'act only on mail messages

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
If IsInDefaultStore(objFolder) Then
Set Item.SaveSentMessageFolder = objFolder
Set msg = Item.Copy
msg.Move objNS.GetDefaultFolder(olFolderSentMail)
End If
End If
End If
End If
Set objFolder = Nothing
Set objNS = Nothing
End Sub
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
Set objApp = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function

 

[Rob Vega]

Just when I thought it was safe to celebrate... it works by bringing up the prompt and copying the sent item to a local folder, if I choose a shared mailbox folder it doesn't copy the item (no error message, I go to the folder and it's just empty) My current permission on the shared mailbox and subfolders is Owner. Is there something in the above code that is limiting to only local folders?

 

[Michael Bauer]

Outlook doesn't support the SaveSentMessageFolder property for shared mailboxes. You need to trigger your code in the ItemsAdd event of your folder for sent items, there move the item.

 

[Rob Vega]

Thank you Michael, that explains why it wasn't copying from the Shared Sent Items folder.

I'm unsure what you mean when you say I need to trigger the code in the ItemsAdd event of my sent items folder and move it there.

Unfortunately, I'm still scaling this mountain that is VBA coding and appear to be at the base of the climb.

I've tried to specify the sent items folder for the shared inbox -

Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim msg As MailItem


If Item.SentOnBehalfOfName = "Issues Management - Networks" Then

If Item.Class = olMail Then 'act only on mail messages

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
If IsInDefaultStore(objFolder) Then
Set Item.Folders("Issues Management - Networks").Folders("Sent Items") = objFolder
Set msg = Item.Copy
msg.Move objNS.GetDefaultFolder(olFolderSentMail)
End If
End If
End If
End If
Set objFolder = Nothing
Set objNS = Nothing
End Sub

 

[Rob Vega]

Hmm, I tried to do more research and I think I understand what you mean Michael. Even so, I tried a different approach and still found it not copying the sent item to the folder chosen in the prompt.

Here is my second attempt (any suggestions or help would be greatly appreciated):

'SavenSend
Private Sub Application_ItemSend(ByVal Item As Object, _
 Cancel As Boolean)
 Dim objNS As NameSpace
 Dim objFolder As MAPIFolder
 Dim msg As MailItem
 Dim Sender As MailItem
 Dim oNameSpace As Outlook.NameSpace
 Dim oSentItems As Outlook.Items
 
 If Item.SentOnBehalfOfName = "Issues Management - Networks" Then 'Added this line
 If Item.Class = olMail Then 'act only on mail messages
 
Set objNS = Application.GetNamespace("MAPI")
 Set oSentItems = oNameSpace.Folders("Issues Management - Networks").Folders("Sent Items").Items
 Set objFolder = objNS.PickFolder
 If Not objFolder Is Nothing Then
 If IsInDefaultStore(objFolder) Then
 Set msg = Item.Copy
 msg.Move objNS.GetDefaultFolder
 End If
 End If
 End If
 End If
 Set objFolder = Nothing
 Set objNS = Nothing
 End Sub

 

[Michael Bauer]

You need to subsribe to the ItemAdd event:

private withevents Items as items
'for instance, set the variable in your ItemSend event
set items=application.session.getdefaultfolder(olfoldersentitems).items

Select "items" from the left dropdown box above the code window. That adds the declaration of the ItemAdd event. In that event you need to place the code for moving the item.

The trick now is to find a mechanismen that identifies the sent messages you want to move, or where to move them, respectively. In ItemSend you want to choose a folder, however, you need to retain the information for the ItemAdd event. A method that should work with Exchange is to write the folder path, or the folder's IDs to a custom property of the message.

 

[Nazim]

Hi All,

How do I trigger this code by adding another "Send N File" button on the toolbar?

 

[Diane Poremsky]

it's triggered by a send - if you want to trigger it 'manually' you need to change the name and tweak it a little. something like this

Private Sub SaveNSend ()
<all the dims>

Set objNS = Application.GetNamespace("MAPI")
Set Item = objNS.ActiveInspector.CurrentItem
If Item.SentOnBehalfOfName...