2014-03-30 154 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 
相關問題