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

【问题标题】：Outlook Shared Account does not sync for all usersOutlook 共享帐户不会为所有用户同步
【发布时间】：2020-06-24 05:29:15
【问题描述】：

我有 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 = "MailboxBilling@mycompany.com"
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

显然，更改用户的帐户设置会有所不同，但我很难理解为什么代码会为一个用户而不是另一个用户工作。非常感谢任何帮助。

【问题讨论】：

如果我理解正确，你试过myNamespace.GetSharedDefaultFolder吗？
类似NameSpace.GetSharedDefaultFolder Method (Outlook)
@Siddharth 我非常依赖 SO 来研究 VBA 问题，您的许多贡献的彻底性和礼貌给我留下了深刻的印象。您提供的链接很有趣。这个客户很难获得测试文件，所以我可能需要几周的时间才能进行充分的实验。请不要将延迟回复视为顺从。非常感谢您对我的问题的关注。

标签： excel vba outlook

【解决方案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("MailboxBilling@mycompany.com")
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

【讨论】：