Results 1 to 2 of 2

Thread: click and send to multiple emails

  1. #1

    click and send to multiple emails

    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi there,

    I am new here, please forgive me if this has already been asked and answered. I have looked around and cannot find it.

    I am trying to send to multiple emails from a click in excel. i.e. click on the email and send to one address and CC to another. Can anyone please advise? I know if I put an email address into a cell, when I click it will send. But cannot figure out the second part

    Thank you

  2. #2
    Neophyte pareshj's Avatar
    Join Date
    May 2014
    You can attach this to a button or other event
    Assuming :
    Col C has name of person to whom mail is to be send
    Col D has "To" email ID
    Col F has "Cc" email ID
    Col G has Yes/No condition
    Col H has Subject
    Col I has Mail Content

    Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Tocell As Range
    Dim CCCell As Range
    Dim SigString As String
    Dim Signature As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
    Signature = ""
    End If

    On Error GoTo cleanup
    For Each Tocell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
    For Each CCCell In Columns("F").Cells.SpecialCells(xlCellTypeConstants)
    If Tocell.Value Like "?*@?*.?*" And _
    LCase(Cells(Tocell.Row, "G").Value) = "yes" Then
    If CCCell.Value Like "?*@?*.?*" And _
    LCase(Cells(CCCell.Row, "G").Value) = "yes" Then

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = Tocell.Value
    .cc = CCCell.Value
    .Subject = Cells(Tocell.Row, "H").Value
    .Body = "Dear " & Cells(Tocell.Row, "C").Value & "," _
    & vbNewLine & vbNewLine & _
    Cells(Tocell.Row, "I").Value _
    & vbNewLine & vbNewLine _
    & vbNewLine _
    & Signature
    '.Attachments.Add ("C:\test.txt")
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    End If
    End If
    Next CCCell
    Next Tocell

    Set OutApp = Nothing
    Application.ScreenUpdating = True

    MsgBox "Mail/s sent successfully.... please check Mailbox", , "Mail Sender"

    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts