Emailing from within Excel

[Graham C1600]

Hi All,

Hopefully an easy one for somebody.

Basically in Sheet 1 cells A1:A10 I have 10 different email addresses.

I want to put a button on the spreadsheet (happy doing that) but when the button is clicked, I want to create a mail with the recipients from A1:A10. The subject will be what is in cell B1.

So just need the VBA code really in order to create the mail and populate as described above.

 

[Sequoyah]

Hi Graham C1600,
try this code

Sub Mail_Graham()
'https://www.mrexcel.com/board/threads/emailing-from-within-excel.1221544/

Dim Dest            As String, strBody As String, strSubject As String
Dim RngDest         As Range, DestCell As Range
Dim WksMail         As Worksheet
Dim OutApp          As Object, OutMail As Object
    
Set WksMail = ThisWorkbook.Sheets("Sheet1")
Set RngDest = WksMail.Range("A1:A10")

strBody = "Test"
strSubject = WksMail.Range("B1").Value

With Application
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    
    For Each DestCell In RngDest
        If DestCell.Value Like "*@*" Then
            If Dest = "" Then
                Dest = DestCell.Value
            Else
                Dest = Dest & ";" & DestCell.Value
            End If
        End If
    Next
    
    With OutMail
        .to = Dest
        .Subject = strSubject
        .Body = strBody
        .Display
       '.Send
        
        On Error GoTo 0
    
End With

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
End With

End Sub

 

[Graham C1600]

Thanks Sequoyah that worked a treat.

To try and add onto this, if I wanted to break the strbody down over multiple lines instead of 1 continuous sting of text, how would I do that ?

 

[Sequoyah]

Hi @Graham C1600,
thanks for the feedback, just change this line

strBody = "Test"

with

strBody = "Test" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

 

[Sequoyah]

Hi @Graham C1600,
thanks for the feedback, just change this line

strBody = "Test"

with

strBody = "Test" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

 

[Graham C1600]

Hi @Graham C1600,
thanks for the feedback, just change this line

strBody = "Test"

with

strBody = "Test" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

Thanks very much. Works great...

 

[Graham C1600]

Hi Graham C1600,
try this code

Sub Mail_Graham()
'https://www.mrexcel.com/board/threads/emailing-from-within-excel.1221544/

Dim Dest            As String, strBody As String, strSubject As String
Dim RngDest         As Range, DestCell As Range
Dim WksMail         As Worksheet
Dim OutApp          As Object, OutMail As Object
   
Set WksMail = ThisWorkbook.Sheets("Sheet1")
Set RngDest = WksMail.Range("A1:A10")

strBody = "Test"
strSubject = WksMail.Range("B1").Value

With Application
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   
    For Each DestCell In RngDest
        If DestCell.Value Like "*@*" Then
            If Dest = "" Then
                Dest = DestCell.Value
            Else
                Dest = Dest & ";" & DestCell.Value
            End If
        End If
    Next
   
    With OutMail
        .to = Dest
        .Subject = strSubject
        .Body = strBody
        .Display
       '.Send
       
        On Error GoTo 0
   
End With

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
End With

End Sub

Just out of interest. Would it be quite easy to adapt the above to open a blank calendar appointment and populate the recipients and body etc. the same way I have for a mail ? Then I just need to add the date/time of the meeting ? Thanks