Opening an Outlook New Message Email from Excel

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)
Who is Participating?
gowflowConnect With a Mentor Commented:
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.
Hi JaseSt,
You have not specified the sender email
JaseStAuthor Commented:
I'll look it over, but before I do, the sender email address is:
Free tool for managing users' photos in Office 365

Easily upload multiple users’ photos to Office 365. Manage them with an intuitive GUI and use handy built-in cropping and resizing options. Link photos with users based on Azure AD attributes. Free tool!

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.


JaseStAuthor Commented:
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.
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.
JaseStAuthor Commented:
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:
JaseStAuthor Commented:
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!
Well that's what is 'good developpment' all about !! Am glad I am part of getting your daily work more organised and better handled.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.