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

Question

我每天都在处理日常报道.这非常耗时.基本上我需要发送电子邮件,其中包含昨天销售与上周和月份销售的简要比较.这工作得很好.完成此操作后,邮件将粘贴到新工作表,然后我必须将其复制并粘贴到Outlook中的新电子邮件中.

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

提前谢谢了!

Answer 1

要添加ActiveWorbook作为附件:

1. 将其保存到特定位置
2. Use Attachments.Add 从1的位置添加文件

码

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

Answer 2

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

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

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