How to send mail to multiple mail IDs from Out look using outlook

[PRAKVIVA]

Hi,

I am stuck with one issue in Excel. I need to send action items to specific mail IDs through the excel :-

Column A - has email ID
Column B - has Subject of Mail
Column C - has Body of Mail

Thank you for your help...

 

[ParamRay]

Here's one method:

Dim m_objOutlookApp As Object

Public Sub SendEmails()
  Dim strEmailAddress As String
  Dim strEmailSubject As String
  Dim strEmailBody As String
  Dim wksSource As Worksheet
  Dim j As Long
  
  On Error Resume Next
' Use existing Outlook instance if applicable
  Set m_objOutlookApp = GetObject(, "Outlook.Application")
  
  If Err.Number <> 0 Then
    On Error GoTo ErrHandler
  ' Otherwise create new instance
    Set m_objOutlookApp = CreateObject("Outlook.Application")
  End If
  
  On Error GoTo ErrHandler
  Set wksSource = ThisWorkbook.Sheets("Sheet1") ' Sheet containing the data
  
' Assume column A is email address, B is subject, C is body.
' Assume headers in 1st row, data starts in 2nd row.
  For j = 2 To wksSource.Cells(wksSource.Rows.Count, "A").End(xlUp).Row
    strEmailAddress = wksSource.Cells(j, "A").Value
    strEmailSubject = wksSource.Cells(j, "B").Value
    strEmailBody = wksSource.Cells(j, "C").Value
    
    On Error GoTo NextRow
    Call SendEmail(strEmailAddress, strEmailSubject, strEmailBody)
NextRow:
  ' Can handle emailing errors here
    On Error GoTo ErrHandler
  Next j
  
ExitProc:
  Set m_objOutlookApp = Nothing
  Set wksSource = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitProc
End Sub

Private Sub SendEmail(strEmailAddress As String, _
                      strEmailSubject As String, _
                      strEmailBody As String)
  
  Const olMailItem = 0
  Dim objMailItem As Object
  
  Set objMailItem = m_objOutlookApp.CreateItem(olMailItem)
  objMailItem.To = strEmailAddress
  objMailItem.Subject = strEmailSubject
  objMailItem.Body = strEmailBody
  objMailItem.Display
' Can replace previous line with: objMailItem.Send
  Set objMailItem = Nothing
End Sub