Email Macro


Active Member
Jan 14, 2006
I am attempting to create a macro that will send out a succession of emails from my spreadsheet

I already have a code to send an email which follows a template and a series of input boxes, such as email dress, project details, etc

However because there are so many emails to send it is still a mundane task having to send out several hundred emails per week

My reasons for sending these emails is to collect some outstanding information which a client has not yet completed

So my aim is as follows,

If cell N4 is blank > send a template email to the email address in D4 including in the body of the email the information present in B4, A4, G4 and L4,

Once the email has been sent move onto the next blank cell in row N and repeat the process

if anyone can give me a helping hand to get the main concepts of the macro going, im sure i will be fine, andy advice is welcomed

Sub Example8()
    Application.ScreenUpdating = False
    Dim oSess As Object
    Dim oDB As Object
    Dim oDoc As Object
    Dim oItem As Object
    Dim direct As Object
    Dim Var As Variant
    Dim flag As Boolean
    Dim EmailAddress As String
    Dim TargetName As String
    Dim ProjectNumber As String
    Dim ProjectDescription As String
    Dim ProjectIssues As String
    EmailAddress = InputBox("Enter The Racfid ID of the offending Staff Member.")
    If EmailAddress = "" Then Exit Sub
    TargetName = InputBox("Enter The full Name of the Offending Staff Member.")
    If TargetName = "" Then Exit Sub
       ProjectNumber = InputBox("Project Number In Question.")
    If TargetName = "" Then Exit Sub
       ProjectDescription = InputBox("Project Name in Question.")
    If TargetName = "" Then Exit Sub
     ProjectIssues = InputBox("Any Further comments or infomation you would like to comment on.")
    If EmailAddress = "" Then Exit Sub
  Set oSess = CreateObject("Notes.NotesSession")
    Set oDB = oSess.GETDATABASE("", "")
    flag = True
    If Not (oDB.IsOpen) Then flag = oDB.Open("", "")
    If Not flag Then
        MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
        GoTo exit_SendAttachment
    End If
    On Error GoTo err_handler
     'Building Message
    oDoc.Form = "Memo"
    oDoc.Subject = "Work Package SLA Missed " & ProjectNumber & " - " & ProjectDescription & ""
    oDoc.sendto = EmailAddress
    oDoc.body = TargetName & vbNewLine _
        & vbNewLine _
        & "Each week We compile a record of all projects  which have been completed, as well as new projects in the process of being assigned " & vbNewLine _
        & vbNewLine _
        & "This information is harvested and maintained daily by the ID Component design Operations Team," & vbNewLine _
        & vbNewLine _
        & "At the end of each month information this information is used to help us to survey team performance " & vbNewLine _
        & vbNewLine _
        & "Our records show that you have recently Completed work on project, " & ProjectNumber & " - " & ProjectDescription & vbNewLine _
        & vbNewLine _
        & "Since the completion of this project has been flagged as being outside of the Agreed SLA" & vbNewLine _
        & vbNewLine _
        & "Please Reply To Sean Hunte with an explanation of why this is " & vbNewLine _
        & vbNewLine _
        & "Further Infomation to be brough to Your attention" & vbNewLine _
        & vbNewLine _
        & ProjectIssues & vbNewLine _
        & vbNewLine _
        & "Regards," & vbNewLine _
        & "Sean Hunte" & vbNewLine _
        & "ID Component Design" & vbNewLine _
        & "Tel: 01603 686322" & vbNewLine _
        & vbNewLine _
        & "                                                                  This is system generated Email" & vbNewLine _

    oDoc.postdate = Date
    oDoc.SaveMessageOnSend = False
     'Attaching DATABASE
    Call oItem.EmbedObject(1454, "", "R:\CONFIDENTIAL\Professional Practice\Team MI & KPI's\Reporting\Team MI Component Design Reporting - Month End - Current.xls")
    oDoc.visable = True
     'Sending Message
    oDoc.SEND False
    On Error Resume Next
    Set oSess = Nothing
    Set oDB = Nothing
    Set oDoc = Nothing
    Set oItem = Nothing
     Application.ScreenUpdating = True
    ActiveCell.FormulaR1C1 = "Target Emails Sent"
    Exit Sub
    If Err.Number = 7225 Then
        MsgBox "The Bench for This coming week has expired; Please create a new Bench report before you send This Notice."
        MsgBox Err.Number & " " & Err.Description
    End If
    On Error GoTo exit_SendAttachment
End Sub

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back