Email VBA

[krisso]

With Covid this year creating a socially distanced secret santa (WFH) I have created a spreadsheet that will select the person who the staff memeber is to buy for. What I would like to do is add to this sheet a VBA so that it emails the name in the list from column B to the email address in Column C inserting the name at the end of text "Your secret santa is......."

Is this possible or am I just looking at a pipe dream. I have looked at Ron de Bruin's solutions but unless I am missing something I dont think it can send a seperate cell to a corresponding cell address in the list.

Any help would be gratefully received

Thanks
Chris

 

[Logit]

This macro can be edited to meet your goal :

Option Explicit

Sub Send_Email()

    Dim c As Range
    Dim strBody As String
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
    
    
    For Each c In Range("G2:G100")
    strBody = "Greetings : " & c.Offset(0, -6).Value & "<br></br><br></br>" _
                & c.Offset(0, -2).Value & "<br></br><br></br><br></br>" _
                & "Sincerely, " & "<br></br><br></br>" _
                & "Your Signature Here"
                
    
        If c.Value <> "" Then
            Set OutLookApp = CreateObject("Outlook.application")
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            With OutLookMailItem
                    .To = c.Offset(0, -5).Value
                    .CC = c.Offset(0, -4).Value
                    .Subject = c.Offset(0, -3).Value
                    .HTMLBody = strBody   'c.Offset(0, -2).Value
                    .Attachments.Add c.Offset(0, -1).Value
                    .Display
                    '.Send
            End With
        End If
    Next c

End Sub

Download workbook : Multi Emails.xlsm

 

[krisso]

This macro can be edited to meet your goal :

Option Explicit

Sub Send_Email()

    Dim c As Range
    Dim strBody As String
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim i As Integer
    On Error Resume Next
   
   
    For Each c In Range("G2:G100")
    strBody = "Greetings : " & c.Offset(0, -6).Value & "<br></br><br></br>" _
                & c.Offset(0, -2).Value & "<br></br><br></br><br></br>" _
                & "Sincerely, " & "<br></br><br></br>" _
                & "Your Signature Here"
               
   
        If c.Value <> "" Then
            Set OutLookApp = CreateObject("Outlook.application")
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            With OutLookMailItem
                    .To = c.Offset(0, -5).Value
                    .CC = c.Offset(0, -4).Value
                    .Subject = c.Offset(0, -3).Value
                    .HTMLBody = strBody   'c.Offset(0, -2).Value
                    .Attachments.Add c.Offset(0, -1).Value
                    .Display
                    '.Send
            End With
        End If
    Next c

End Sub

Download workbook : Multi Emails.xlsm

Amazing. Just what I was looking for. Thank you for your help

 

[Macropod]

You don't actually need any VBA for this - it can all be done via mailmerge from Word.

 

[Logit]

You are welcome ... glad to help.

Cheers !