Email Macro

[cameron_kyle]

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("", "")
    Call oDB.OPENMAIL
    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
    Set oDoc = oDB.CREATEDOCUMENT
    Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
    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
exit_SendAttachment:
    On Error Resume Next
    Set oSess = Nothing
    Set oDB = Nothing
    Set oDoc = Nothing
    Set oItem = Nothing
     'Done
     
     Application.ScreenUpdating = True
    
     Range("c11").Select
    ActiveCell.FormulaR1C1 = "Target Emails Sent"
    Exit Sub
err_handler:
    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."
    Else
        MsgBox Err.Number & " " & Err.Description
    End If
    On Error GoTo exit_SendAttachment
    
    
    
     
End Sub

 

[cameron_kyle]

--