通过Excel VBA在Outlook中打开新邮件

每天我都在处理每日报告。这相当耗时。基本上，我需要发送电子邮件，简要比较昨天的销售额与上周和上月的销售额。这很有效。 完成后，邮件将粘贴到新工作表，然后我必须将其复制并粘贴到Outlook中的新电子邮件中

是否有可能创建一个宏来在Outlook中打开新邮件？这样我就可以插入文本了。 我能够编写宏，直接从Excel发送，但这不是我真正想要的，因为报告的某些部分必须通过手动查看数字来完成

---

非常感谢

我现在无法测试它，但它会是这样的：

set o = createObject("Outlook.Application")
set m = o.CreateItem(olMailItem) ' replace it with 0 if you get error here
o.show ' or .Display - not sure

在显示之前，您可以设置o.To、o.Subject等。 对不起，它没有经过测试，但我的家用电脑上没有Outlook，我只在工作时使用它。

---

如果我没记错的话，我明天会检查一下

我找到了这个，它工作得很好

也许还有一件事-是否可以将打开的文档作为附件附加

Sub CustomMailMessage()
Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients

  Set OutApp = CreateObject("Outlook.Application")
  Set objOutlookMsg = OutApp.CreateItem(olMailItem)

  Set Recipients = objOutlookMsg.Recipients
  Set objOutlookRecip = Recipients.Add("alias@domain.com")
  objOutlookRecip.Type = 1

  objOutlookMsg.SentOnBehalfOfName = "sales@domain.com"
  objOutlookMsg.Subject = "Testing this macro"
  objOutlookMsg.HTMLBody = "Testing this macro" & vbCrLf & vbCrLf
  'Resolve each Recipient's name.
  For Each objOutlookRecip In objOutlookMsg.Recipients
    objOutlookRecip.Resolve
  Next
  'objOutlookMsg.Send
  objOutlookMsg.Display

  Set OutApp = Nothing  
End Sub

---

要将

ActiveWorbook

添加为附件：

将其保存到指定位置

使用附件。添加

从1的位置添加文件

代码

---

第二行出现错误-“对象不支持此属性或方法。+1您可能还想声明变量？：）我已经检查过了，它应该是

o.Display

。错误可能是由于Excel不知道Outlook枚举（请尝试0而不是

olMailItem

）。Siddhart，您是对的（感谢您编辑我的“添加”错误），但是声明变量（尽管是一种好的做法）不是必需的，因此一个声明变量，一个声明变量，而另一个声明变量不是（我声明），这需要参考Microsoft Outlook 16.0对象库

Sub CustomMailMessage()
Dim strFile As String
Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients

  Set OutApp = CreateObject("Outlook.Application")
  Set objOutlookMsg = OutApp.CreateItem(olMailItem)

  strFile = "C:\temp\myfile.xlsx"
  ActiveWorkbook.SaveAs strFile

  Set Recipients = objOutlookMsg.Recipients
  Set objOutlookRecip = Recipients.Add("alias@domain.com")
  objOutlookRecip.Type = 1

  With objOutlookMsg
    .SentOnBehalfOfName = "sales@domain.com"
    .Subject = "Testing this macro"
    .HTMLBody = "Testing this macro" & vbCrLf & vbCrLf
    'Resolve each Recipient's name.
    For Each objOutlookRecip In objOutlookMsg.Recipients
      objOutlookRecip.Resolve
    Next
    .Attachments.Add strFile
    .display
  End With

  'objOutlookMsg.Send
  Set OutApp = Nothing
End Sub