Outlook Shared Account does not sync for all users

Question

I have 2 users. Both users have the same model desktop with the same version of windows(8), the same version of Office(2013), the same version of Outlook. Both machines are hooked up to the network and get regular updates.

Both users are required to send emails from a shared account. The emails MUST be sent from the shared account and CANNOT show either user's email address.

Long story short, the following macro works for only one of the users. When user 2 runs the macro, the emails are sent from his draft folder not the shared one.

If I go into each user's account settings and set the shared account name to the local alias, then the macro doesn't work for either one although it used to work for user 2 and not user 1. For whatever reason, that stopped working about a year ago.

If I go into each user's account settings and set the shared account name to the full email address, then it only works for user 1.

This establishes the connection (or should) to the shared folder.

    'Establish Outlook Settings.
70  Dim objOutlookApp As Object: Set objOutlookApp = CreateObject("Outlook.Application")
71  Dim objOutlookMail As Object
72  Dim eaEMail As Variant
73  Dim varSignature As Variant
74  Dim objNameSpace As Object: Set objNameSpace = objOutlookApp.GetNamespace("MAPI")
    'Make sure the "Drafts" folder isn't active.
75  Dim objMyInbox As Object: Set objMyInbox = objNameSpace.GetDefaultFolder(6) 'olFolderInbox
    'Find the Shared Mailbox.
76  Dim objShareDraft As Object
77  For Each objShareDraft In objNameSpace.Folders
78      If objShareDraft.Name Like "The Folder I Need" Then Exit For
79  Next objShareDraft
80  If objShareDraft Is Nothing Then Err.Raise 42, , "Mailbox Not Found."
81  Set objShareDraft = objShareDraft.Folders("Drafts")

This generates the email and attaches a file.

82  For Each objFile In objFiles
        'Do Stuff.

143         Set objOutlookMail = objOutlookApp.CreateItem(0)
144         With objOutlookMail

145             If blnTEST = False Then
146                 .SentOnBehalfOfName = "[email protected]"
147             End If
                'Capture Signature Block.
148             .Display
149             varSignature = .HTMLBody

                'Look up supplier addressees from a dictionary (dnySuppAddr).
154             If dnySuppAddr.Exists(strClientNm) Then
                    .To = dnySuppAddr(strClientNm)(0)
                    .CC = dnySuppAddr(strClientNm)(1)
155             End If
156             .Attachments.Add sOutPath
157             .Subject = "Invoice For " & strClientNm & " - week-ending " & dtWkEnd
158             .HTMLBody = "<font size=4><p>Invoice for week-ending " & dtWkEnd & "</p>" & _
                    "<p>Includes: " & strClientNm & "</p>" & _
                    "<p>Total amount: " & Format(TotalAmt, "Currency") & "</p>" & _
                    "<p>Please review and process for payment.</p>" & _
                    varSignature
159                 .Close 0 'olSave

This is where it fails to work. There is no error thrown. It just doesn't move the email from user 2's draft to the shared draft.

160             If blnTEST = False Then
161                 For Each eaEMail In objNameSpace.GetDefaultFolder(16).Items 'olFolderDrafts
162                     If eaEMail.Subject Like "Invoice For " & strClientNm & " - week-ending " & dtWkEnd Then eaEMail.Move objShareDraft
163                 Next eaEMail
164             End If
165         End With

Clearly changing the user's account settings makes a difference, but I'm stumped as to why the code would otherwise work for one user and not another. Any help is greatly appreciated.

If I understand you correctly, have you tried myNamespace.GetSharedDefaultFolder? — Siddharth Rout
Something like NameSpace.GetSharedDefaultFolder Method (Outlook) — Siddharth Rout
@Siddharth I have relied very heavily on SO for researching VBA questions and I’ve been impressed by the thoroughness and courtesy of your many contributions. The link you provided is intriguing. Test files are very difficult to get for this client so it could be a matter of weeks before I can adequately experiment. Please do not consider a delayed response as complaisance. I do sincerely appreciate your attention to my problem. — pondersome

pondersome pondersome · Accepted Answer · 2019-02-20T04:00:58

Many thanks to Siddharth Rout and http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ for the answer. (My apologies for the 6 month delay in posting) I had to make one small change because none of the available resources worked as printed, however, when I changed the olFolderDrafts in the .GetSharedDefaultFolder method to its value of 16 everything worked perfectly.

Lines 70, 74, 76 - 81 from the first code block in my question above has been changed accordingly. All else remains the same.

    'Establish Outlook Settings.
67  Dim objOutlookApp As Object: Set objOutlookApp = CreateObject("Outlook.Application")
68  Dim objNameSpace As Object: Set objNameSpace = objOutlookApp.GetNamespace("MAPI")
69  Dim objRecipient As Object: Set objRecipient = objNameSpace.CreateRecipient("[email protected]")
70  objRecipient.Resolve
    'Find the Mailbox.
71  Dim objShareDraft As Object: Set objShareDraft = objNameSpace.GetSharedDefaultFolder(objRecipient, 16) '16 = olFolderDrafts - The text constant doesn't work for some undocumented reason

Outlook Shared Account does not sync for all users

1 Answers