Outlook共享帐户不会同步所有用户

Question

我有2个用户。两个用户都具有相同型号的桌面，具有相同版本的Windows（8），相同版本的Office（2013），相同版本的Outlook。两台机器都连接到网络并定期更新。

两个用户都需要从共享帐户发送电子邮件。电子邮件必须从共享帐户发送，并且不能显示用户的电子邮件地址。

长话短说，以下宏只适用于其中一个用户。当用户2运行宏时，电子邮件从他的草稿文件夹而不是共享文件夹发送。

如果我进入每个用户的帐户设置并将共享帐户名设置为本地别名，则该宏对任何一个都不起作用，尽管它曾用于用户2而不是用户1.无论出于何种原因，该操作都停止了一年前。

如果我进入每个用户的帐户设置并将共享帐户名称设置为完整的电子邮件地址，则它仅适用于用户1。

这将建立与共享文件夹的连接（或应该）。

    '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")

这会生成电子邮件并附加文件。

82  For Each objFile In objFiles
        'Do Stuff.

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

145             If blnTEST = False Then
146                 .SentOnBehalfOfName = "[e-mail]"
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

这是它无法工作的地方。没有抛出错误。它只是不会将电子邮件从用户2的草稿移动到共享草稿。

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

显然更改用户的帐户设置会有所不同，但我很难过为什么代码对一个用户而不是另一个用户起作用。任何帮助是极大的赞赏。

Answer 1

非常感谢Siddharth Rout和http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/的答案。 （我对发布的6个月延迟表示道歉）我不得不做一个小改动，因为没有一个可用的资源可以打印，但是，当我将.GetSharedDefaultFolder方法中的olFolderDrafts更改为16的值时，一切都运行得很好。

我上面问题中第一个代码块的第70,74,76-81行已相应更改。其他一切都是一样的。

    '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("[e-mail]")
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