2014-03-30 114 views
3

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

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

非常感谢提前!

+0

和想法?谢谢 – Petrik

回答

3

我找到了这个,它工作完美!

只是一个额外的事情 - 是否有可能附加打开的文件作为附件?

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("[email protected]") 
    objOutlookRecip.Type = 1 

    objOutlookMsg.SentOnBehalfOfName = "[email protected]" 
    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 
4

我现在不能测试,但它会是这样的:

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,我只在工作时使用它。 如果我记得正确,我会明天检查它。

+0

第二行有错误 - “对象不支持这个属性或方法 – Petrik

+0

+ 1你可能想声明你的变量吗?:) –

+0

我已经检查过了,应该是'o.Display'。Error可能是由于Excel不知道Outlook枚举引起的(尝试使用0而不是'olMailItem')。Siddhart,你是对的(感谢编辑我的'添加'错误),但是声明变量(虽然是一个好习惯)并不是必须的,所以一个没有和一个不喜欢(我确实) – avb

4

要作为附件添加ActiveWorbook

  1. 保存到一个specifc位置
  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("[email protected]") 
    objOutlookRecip.Type = 1 

    With objOutlookMsg 
    .SentOnBehalfOfName = "[email protected]" 
    .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 
相关问题