CODEWITHSUNDEEP
vbaexceloutlook
Petrik
Petrik

Reputation: 827

Open new message in Outlook by Excel VBA

everyday I am handling daily reporting. Which was quite time consuming. Basically I need to send email containing brief comparison of sales yesterday with sales last week and month. That is working pretty well. Once this is done the message is pasted to new sheet and then I have to copy it and paste into new email in Outlook.

Is there a possibility to create macro that will open new message in Outlook? So I'll be able to insert my text. I am able to write macro that will send it directly from Excel but this is not something I really want to as some part of the reporting must by done by looking at numbers manually.

Many thanks in advance!

Upvotes: 5

Views: 79443

Answers (3)

Petrik
Petrik

Reputation: 827

I've found this one and it is working perfectly!!!!

Just maybe one extra thing - is there a possibility to attach opened document as a attachment? 

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

Upvotes: 7

brettdj
brettdj

Reputation: 55682

To add the ActiveWorbook as an attachment:

  1. Save it to a specifc location
  2. Use Attachments.Add to add the file from the location from 1

code

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

Upvotes: 9

avb
avb

Reputation: 1753

I cannot test it now, but it would go like this:

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

You can set o.To, o.Subject etc. before displaying it. Sorry it is not tested but I do not have Outlook on my home computer, I use it only at work. I will check it tomorrow if I remembered correctly.

Upvotes: 4

Related Questions