Question

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

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

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

如果我进入每个用户的帐户设置并将共享帐户名设置为本地别名，则该宏既不能用于用户2，也可以用于用户1，但对任何一个都不起作用。大约一年前停止工作。

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

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

Paint

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

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

这是无法正常工作的地方。没有引发任何错误。只是不会将电子邮件从用户2的草稿移到共享草稿。

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

显然，更改用户的帐户设置会有所不同，但是我对为什么该代码对一个用户而不对另一个用户有效的原因感到困惑。任何帮助将不胜感激。

Answer 1

非常感谢Siddharth Rout和http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/的回答。（我很抱歉推迟6个月的发布），我不得不做一个小小的更改，因为没有可用的资源像打印的那样正常工作，但是，当我将.GetSharedDefaultFolder方法中的olFolderDrafts更改为16时，一切正常。 / p>

我上面问题中的第一个代码块的第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

Outlook共享帐户不能为所有用户同步

1 个答案: