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

Status
Not open for further replies.

Rob Vega

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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)

Code:
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
 
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 :p)

Code:
'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
 
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?
 
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.
 
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 -

Code:
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
 
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):

Code:
'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
 
You need to subsribe to the ItemAdd event:
Code:
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.
 
Hi All,

How do I trigger this code by adding another "Send N File" button on the toolbar?
 
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...
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
C Outlook 365 Copy/Save Emails in Folder Outside Outlook to Show Date Sender Recipient Subject in Header Using Outlook 0
D outlook to save copy of hotmail? Using Outlook 3
G Save emails as msg file from Outlook Web AddIn (Office JS) Outlook VBA and Custom Forms 0
E Outlook 365 Save Selected Email Message as .msg File - oMail.Delete not working when SEARCH Outlook VBA and Custom Forms 0
E Save Selected Email Message as .msg File - digitally sign email doesn't works Outlook VBA and Custom Forms 1
M Outlook Macro to save as Email with a file name format : Date_Timestamp_Sender initial_Email subject Outlook VBA and Custom Forms 0
W Create a Quick Step or VBA to SAVE AS PDF in G:|Data|Client File Outlook VBA and Custom Forms 1
C Outlook (desktop app for Microsoft365) restarts every time I save my VBA? Using Outlook 1
D VBA Macro to Print and Save email to network location Outlook VBA and Custom Forms 1
N VBA Macro To Save Emails Outlook VBA and Custom Forms 1
N Save emails within a certain date range to network drive Outlook VBA and Custom Forms 0
T Outlook 365 Move newly created tasks automatically on save. Outlook VBA and Custom Forms 1
G Save attachment run a script rule Outlook VBA and Custom Forms 0
N Save Selected Email Message as .msg File Outlook VBA and Custom Forms 12
G Save and Rename Outlook Email Attachments Outlook VBA and Custom Forms 0
G VBA to save selected Outlook msg with new name in selected network Windows folder Outlook VBA and Custom Forms 1
D Outlook 2016 64bit, Cannot Save in 'HTML', format Using Outlook 1
N Save selected messages VBA does not save replies and/or messages that contain : in subject Outlook VBA and Custom Forms 1
L Macro to add Date & Time etc to "drag to save" e-mails Outlook VBA and Custom Forms 17
S save attachment with date & time mentioned inside the file Outlook VBA and Custom Forms 0
S Add VBA save code Using Outlook 0
A Edit attachment Save and Reply Outlook VBA and Custom Forms 0
S Outlook (2016 32bit; Gmail IMAP) - Save sent message to Outllook Folder Outlook VBA and Custom Forms 0
P Outlook pst file is too huge with POP3. How to save more space? Using Outlook 4
D Prevent popup of "Do you want to save changes?" when closing after opening an appointment to view Outlook VBA and Custom Forms 2
A Unable to save recurring Meeting to Documents folder due to error Using Outlook 2
M Outlook 2013 Script Assistance - Save Opened Link with Subject Added Outlook VBA and Custom Forms 1
R Use an ItemAdd to Save Attachments on Arrival Outlook VBA and Custom Forms 0
W Outlook Calendar does not save view any longer! Using Outlook 3
S automate save the .xlxs file to share Network Using Outlook 1
S save email from excel Outlook VBA and Custom Forms 1
Y Open and Save Hyperlink Files in multiple emails Outlook VBA and Custom Forms 9
9 Outlook 2016 How to save an Outlook attachment to a specific folder then delete the email it came from? Using Outlook 1
O Save attachments using hotkey without changing attributes Outlook VBA and Custom Forms 1
geofferyh Cannot get Macro to SAVE more than one message attachment??? Outlook VBA and Custom Forms 5
N Open & Save VBAProject.Otm using VBA Code Outlook VBA and Custom Forms 1
R VBA | Chosing path to save file Outlook VBA and Custom Forms 1
W Save and rename outlook email attachments to include domain name & date received Outlook VBA and Custom Forms 4
V Change default default save location to Quick Access Using Outlook 1
W Save Outlook attachment in network folder and rename to current date and time Outlook VBA and Custom Forms 18
C Change default "Save Sent Item To" folder Outlook VBA and Custom Forms 9
C Outlook - cannot save subject line changes Using Outlook 2
J Save E-mail attachments in a specific folder Outlook VBA and Custom Forms 0
I Outlook 2016 64bit - on receipt convert emails into PDF and save Outlook VBA and Custom Forms 2
V VB script code to save a specific email attachment from a given email Outlook VBA and Custom Forms 14
C Auto save outlook attachments when email is received Outlook VBA and Custom Forms 1
N editing drafts - won't let me save Using Outlook 12
nathandavies Email Details to Excel & Save as .MSG on one macro - combination of 2 macros Outlook VBA and Custom Forms 3
C Need VBA code to automatically save message outside outlook and add date Outlook VBA and Custom Forms 1
D Save Sent Item to Using Outlook 0

Similar threads

Back
Top