Outlook多Exchange账户下，VBA创建指定账户邮件存草稿失败求助

问题根源 #

直接用Outlook.Application.CreateItem(olMailItem)创建邮件时，默认归属配置文件的首个账户。即便后续设置SendUsingAccount，邮件的父文件夹仍属于首个账户的草稿夹，执行.Close olSave时会自动存入该文件夹，而非目标账户的草稿。

解决思路 #

要让邮件存入指定账户的草稿文件夹，需直接在目标账户的草稿文件夹中创建邮件，而非先创建邮件再切换账户。核心步骤：

1. 遍历Outlook账户集合找到目标账户对象
2. 获取该账户对应的草稿文件夹
3. 在该文件夹内创建邮件并配置属性

完整VBA代码示例 #

Sub SaveDraftToSpecificAccount()
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim targetAccount As Outlook.Account
    Dim targetDraftFolder As Outlook.Folder
    Dim outlookMail As Outlook.MailItem
    Dim targetSmtp As String
    
    ' 替换为目标账户的SMTP地址
    targetSmtp = "Administrator@xyz.com.au"
    
    ' 初始化Outlook对象
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    
    ' 遍历账户找到目标账户
    For Each targetAccount In olApp.Accounts
        If LCase(targetAccount.SmtpAddress) = LCase(targetSmtp) Then
            ' 获取目标账户的草稿文件夹（最可靠的方式）
            Set targetDraftFolder = targetAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
            Exit For
        End If
    Next targetAccount
    
    ' 确认找到目标文件夹后创建邮件
    If Not targetDraftFolder Is Nothing Then
        Set outlookMail = targetDraftFolder.Items.Add(olMailItem)
        
        With outlookMail
            ' 绑定目标账户对象（必须用Account对象，不能直接传字符串）
            .SendUsingAccount = targetAccount
            .To = emailAddress.Value ' 替换为你的收件人变量
            .Subject = "Your Worksheet: " & ws.Name ' 替换为你的工作表变量
            .Body = "Dear " & consultantName.Value & "," & vbCrLf & vbCrLf & _
                   "Please find attached the calculation of your latest commission payment." & vbCrLf & vbCrLf & _
                   "This payment was processed in this month’s payroll." & vbCrLf & vbCrLf & _
                   "Should you have any queries regarding the attached, please do not hesitate to contact your line manager." & vbCrLf & vbCrLf & _
                   "Kind regards," & vbCrLf & _
                   "Shann"
            .Attachments.Add fileName ' 替换为你的附件路径变量
            .Close olSave ' 直接存入目标账户的草稿文件夹
        End With
        
        ' 释放对象
        Set outlookMail = Nothing
        Set targetDraftFolder = Nothing
    End If
    
    Set targetAccount = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub

关键注意事项 #

• 必须用Account对象赋值：SendUsingAccount不能直接传邮箱字符串，必须绑定Outlook.Account对象，避免因显示名称、大小写差异导致匹配失败。
• 可靠获取草稿文件夹：通过targetAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)关联目标账户的存储区，不会因文件夹名称本地化（如英文"Drafts"、中文"草稿"）出现查找错误。
• 引用Outlook对象库：在VBA编辑器中点击「工具」→「引用」，勾选「Microsoft Outlook xx.x Object Library」（xx.x对应你的Outlook版本）。

内容的提问来源于stack exchange，提问作者Craig Curtin