Outlook 2007 Macro for sending mail automatically

[HansV]

Try this version. It splits the Email variable into separate recipients.

Code: Select all

Sub SendGenMsg()
    Const CompanyCol = "A"
    Const MailCol = "B"
    Const FirstRow = 2
    Dim LastRow As Long
    Dim StartRow As Long
    Dim CurRow As Long
    Dim Company As String
    Dim Email As String
    Dim Filename As String
    Dim StartedOL As Boolean
    Dim olApp As Object
    Dim olMsg As Object
    Dim arrNames
    Dim i As Long

    On Error Resume Next
    Set olApp = GetObject(Class:="Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject(Class:="Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Cannot start Outlook!", vbExclamation
            Exit Sub
        End If
        StartedOL = True
    End If
    On Error GoTo ErrHandler
    olApp.Session.Logon

    LastRow = Range(CompanyCol & Rows.Count).End(xlUp).Row
    ' Process in batches of 50
    For StartRow = FirstRow To LastRow Step 50
        For CurRow = StartRow To Application.Min(StartRow + 49, LastRow)
            Company = Range(CompanyCol & CurRow).Value
            Email = Range(MailCol & CurRow).Value
            Set olMsg = olApp.CreateItem(0) ' olMailItem
            olMsg.Subject = "CONFIRMATION OF BALANCE for " & Company
            olMsg.Body = "Dear Sir " & vbNewLine & _
               "            " & vbNewLine & _
               "Thank you for your support!" & vbNewLine & _
               "     " & vbNewLine & _
               "Kindly send us back the signed copy of Confirmation of Balance statement, which we sent 2 weeks back through First flight courier as early as possible." & vbNewLine & _
               "Please contact Mr.Saravanan at saisaravanan@iljin.com or +91-90030 71022  for further queries." & vbNewLine & _
               "Kindly ignore this mail if you already sent back the letter" & vbNewLine & _
               "                            " & vbNewLine & _
               "                            " & vbNewLine & _
               "                            " & vbNewLine & _
               "Regards," & vbNewLine & _
               "Srinivasan P" & vbNewLine & _
               "ILJIN Automotive pvt Ltd" & vbNewLine & _
               "B1&B2, SIPCOT INDUSTRIAL PARK" & vbNewLine & _
               "Irungattukottai, Sriperumbudur" & vbNewLine & _
               "Tamilnadu - 602 105" & vbNewLine & _
               "Mobile : 98416 77464"
            ' Split e-mail address into separate recipients
            arrNames = Split(Email, ";")
            For i = 0 To UBound(arrNames)
                olMsg.Recipients.Add arrNames(i)
            Next i
            ' Add CC
            olMsg.cc = "mohan@iljin.com;saisaravanan@iljin.com"
            ' To test, open the message:
            olMsg.Display
            ' For the final version, send it immediately:
            olMsg.Send
        Next CurRow
    Next StartRow

ExitHandler:
    On Error Resume Next
    If StartedOL And Not olApp Is Nothing Then
        olApp.Quit
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[srinivasanyadhav]

It Works,
Thanks!