Opening an Outlook New Message Email from Excel

Posted on 2011-09-13
Last Modified: 2012-08-13
continuation from previous related question:

7. after doing point 6 from previous question, then open a new email message (outlook 2007)
8. add the attachment of this newly created Mastercard - sm spreadsheet to it
9. add to the body of the email message the below text:

Dear Nalleli,

Please see attached file for regular load request.

Please let me know you received this email.

Thank you.


10. insert into the subject line this text:

MC - smTODAY'S DATE (example: MC-smSept10-11)
Question by:JaseSt
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
LVL 30

Expert Comment

ID: 36531757
Hi JaseSt,
You have not specified the sender email
LVL 30

Accepted Solution

gowflow earned 500 total points
ID: 36531969
It seems it went faster than expected !!! (compensating on hte slow start :) )

1) Copy the below code to Module1 after any End Sub (SELECT ALL right click COPY and paste in module1 after any END SUB)

Sub SendEmail(fName As String)
Dim wb As Workbook
Dim ws As Worksheet

Dim SendTo As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String

Application.DisplayAlerts = False

'Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")

'Fill in Subject Details'
subject_ = "MC-" & Format(Now, "Mmmd-yy")
attach_ = fName
SendTo = ""

'Create the Email
Set MItem = OutlookApp.CreateItem(0)
With MItem
  .To = SendTo
  .Subject = subject_
  .Attachments.Add (attach_)
  .Body = "Dear Nalleli," & Chr(10) & Chr(10) _
    & "Please see attached file for regular load request." & Chr(10) _
    & "PIC:99554Freedom" & Chr(10) & Chr(10) _
    & "Please let me know you received this email." & Chr(10) & Chr(10) _
    & "Thank you." & Chr(10) & Chr(10) _
    & "Michael" & Chr(10) _
    & "Sovereign Gold Card Support" & Chr(10) _
    & ""

  'Send the Email
End With

'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing

Application.DisplayAlerts = True
End Sub

Open in new window

2) Doubleclick Module2 set the lower icon to view 1 sub at a time (left icon)
3) Display Sub PushToBook
4) Delete the whole Sub
5) Copy the below code and paste it in Module2 (SELECT ALL right click COPY and PASTE after any END SUB in module2)

Sub PushToBook()
Dim ws As Worksheet
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow, I, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String

If gstFolderPushToBook = "" Then
    MsgBox ("You need to select a destination folder to store the PushToBook files created. Please go to Sheet 'Main' and select a folder before proceeding further.")
    Exit Sub
    If MsgBox("This process will create a new workbook with today's date and load in it all records in sheet 'MC Consolidated' that beare today's date." & Chr(10) & Chr(10) _
        & "Are you ready to start this process ?", vbQuestion + vbYesNo, "Push To Book") = vbYes Then
        Set ws = ActiveSheet
        Set NewWb = Workbooks.Add
        Set NewWS = NewWb.Sheets("Sheet1")
        NewWS.Name = Format(Now, "mm-dd-yyyy")
        'Mastercard - smSept9-11.xls'
        NewWb.SaveAs Filename:=gstFolderPushToBook & "Mastercard - sm" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
        NewWorkB = NewWb.Name
        J = 1
        MaxRow = ws.UsedRange.Rows.count
        ws.UsedRange.AutoFilter Field:=10, Criteria1:=">=" & Date, Operator:=xlAnd, Criteria2:="<=" & Date
        For I = 1 To MaxRow
            If ws.Range(I & ":" & I).EntireRow.Hidden = False Then
                ws.Range("A" & I & ":I" & I).copy NewWS.Cells(J, 1)
                J = J + 1
            End If
        Next I
        ws.AutoFilterMode = False
        processCC NewWS
        With NewWS.Columns("A:I")
           .HorizontalAlignment = xlCenter
        End With
        Application.DisplayAlerts = False
        For Each WSS In NewWb.Worksheets
            If WSS.Name <> NewWS.Name Then WSS.Delete
        Next WSS
        'Set NewWb = Nothing
        'Set NewWS = Nothing
        Application.DisplayAlerts = True
        MsgBox ("Workbook: '" & NewWorkB & "' has been created successfully")
        SendEmail NewWb.FullName
    End If
End If
End Sub

Open in new window

6) Save the workbook ONTO A NEW NAME !!!!
7) Exit the workbook
8) start the workbook and activate pushToBook command and check the results.

PS we can add the Sender email when provide it.
Pls let me know your comments.

Author Comment

ID: 36532257
I'll look it over, but before I do, the sender email address is:
NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

LVL 30

Expert Comment

ID: 36534147
ok then pls replace this following Line in Sub SendEmail
1) goto VBA
2) doubleclick Module1 click on left icon to view 1 sub at a time
3) Display Sub SendEmail(fName As String)
4) Replace This Line (in the first couple lines of the Sub under 'Fill in Subject Details)
SendTo = ""
By this Line
SendTo = ""
5) Save the workbook and close it
6) Start it again and try it out.



Author Closing Comment

ID: 36536787
Beautiful! Worked like a charm!!!

I ran it before I saw your last comment. I will insert that into the code and try it again tomorrow am with the send to address.

Great work, gowflow! Thank you.

I have a few other things for this MasterCard workbook - fairly simple I believe - and then have a few others for my Visa workbook if interested.
LVL 30

Expert Comment

ID: 36536837
Shoot all the questions that you want. Pls post here any other issue you may need help with as cannot screen all questions beeing posted to find yours. I had similar issue with an other question where the guy said he would post a new question he never told me about it and I waited he cot it answered where it all started with my formula.

Author Comment

ID: 36540057
Great! Here's the next one. You've done something very similar with going through Outlook and retrieving data for 'individual' sheets. This question is for emails coming in from our resellers: the MCR and HMF Account pages:

Author Comment

ID: 36542627
Inserted the send to email address and it worked perfectly. Wow! Great work gowflow. Getting rid of the day after day repetitive actions certainly saves me a lot of time and reduced potential for human error.
Thanks again!
LVL 30

Expert Comment

ID: 36544961
Well that's what is 'good developpment' all about !! Am glad I am part of getting your daily work more organised and better handled.

Featured Post

[Webinar] How Hackers Steal Your Credentials

Do You Know How Hackers Steal Your Credentials? Join us and Skyport Systems to learn how hackers steal your credentials and why Active Directory must be secure to stop them. Thursday, July 13, 2017 10:00 A.M. PDT

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

696 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question