How to add cell data into an email

[sassriverrat]

I have this code that I use for sending emails. It used to input one cell for the subject of the email and it used a second cell for the body. However, I was wondering if there was a way that I could use multiple cells of data for the "body" of the email. More importantly, the cells have to be formatted in the body so that if each cell of data is a new line of text in the email if that makes sense. Basically if cell A1 has "H" in it and A2 has "I", the first line of the email should have H and the second line should have I so that "HI" is read vertically.

Secondly, is there a way, while this code is running, to have excel print the email as well? Thank!

Public Sub EmailAmver()

'Begins Error Handling Code
On Error GoTo Helper


    Dim OutApp As Object, OutMail As Object
    Dim emailSubject As String, bodyText As String, toEmailAddresses As String
 
    Dim name As String
    name = Sheets("Notes").Range("N4")
        
    'Sets parameters of email
    With ThisWorkbook.Worksheets("Notes")
        emailSubject = .Range("L56").Value
        bodyText = .Range("L51").Value
        toEmailAddresses = ""
        For Each cell In .Range("L34:L34")
            If cell.Value Like "?*@?*.?*" Then toEmailAddresses = toEmailAddresses & cell.Value & ";"
        Next
    End With
    


            
    End With
    
    'sets outlook to run
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'On Error Resume Next
    With OutMail
        .To = Left(toEmailAddresses, Len(toEmailAddresses) - 1)
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = bodyText
        .Attachments.Add TempFileName
        .Send
    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Kill TempFileName
    
'Error Clearing Code
Exit Sub
Helper:
    resp = MsgBox("We're sorry to see you've encountered an error." & vbCrLf & vbCrLf & "To proceed, we recommend you contact the Developer " & _
    "with error codes [1111] and " & "[" & Err.Number & "-" & Err.Description & "]." & vbCrLf & vbCrLf & "To attempt to patch your problem at least " & _
    "temporarily, we recommend you click [Yes] to see help directions. Would you like to continue?", vbYesNoCancel, name)
        If resp = vbYes Then
            Call Error_Handle(sprocname, Err.Number, Err.Description)
        ElseIf resp = vbNo Then
            Exit Sub
        ElseIf resp = vbCancel Then
            Exit Sub
        End If
        
End Sub

 

[James006]

Hello,

If you need to format your email body with bold, font, etc ... you will have to use HTML (.HTMLBody)

Hope this will help

 

[Logit]

.

Public Sub EmailAmver()


'Begins Error Handling Code
'On Error GoTo Helper




    Dim OutApp As Object, OutMail As Object
    Dim emailSubject As String, bodyText As String, toEmailAddresses As String
 
    Dim name As String
    name = Sheets("Notes").Range("N4")
        
    'Sets parameters of email
    With ThisWorkbook.Worksheets("Notes")
        emailSubject = .Range("L56").Value
        
[B][COLOR=#ff0000]        bodyText = .Range("L51").Value & vbCrLf[/COLOR][/B]
[B][COLOR=#ff0000]        bodyText = bodyText & .Range("L52").Value & vbCrLf[/COLOR][/B]
[B][COLOR=#ff0000]        bodyText = bodyText & .Range("L53").Value[/COLOR][/B]

        toEmailAddresses = ""
        For Each cell In .Range("L34:L34")
            If cell.Value Like "?*@?*.?*" Then toEmailAddresses = toEmailAddresses & cell.Value & ";"
        Next
    End With
    
    'sets outlook to run
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'On Error Resume Next
    With OutMail
        .To = Left(toEmailAddresses, Len(toEmailAddresses) - 1)
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        
        .Body = bodyText
        
        '.Attachments.Add TempFileName
        '.Send
        .Display

[B][COLOR=#ff0000] OutMail.PrintOut[/COLOR][/B]

    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    'Kill TempFileName
    
'Error Clearing Code
Exit Sub
Helper:
    resp = MsgBox("We're sorry to see you've encountered an error." & vbCrLf & vbCrLf & "To proceed, we recommend you contact the Developer " & _
    "with error codes [1111] and " & "[" & Err.Number & "-" & Err.Description & "]." & vbCrLf & vbCrLf & "To attempt to patch your problem at least " & _
    "temporarily, we recommend you click [Yes] to see help directions. Would you like to continue?", vbYesNoCancel, name)
        If resp = vbYes Then
            'Call Error_Handle(sprocname, Err.Number, Err.Description)
        ElseIf resp = vbNo Then
            Exit Sub
        ElseIf resp = vbCancel Then
            Exit Sub
        End If
        
End Sub

 

[VBE313]

rondebruin.nl will be your favorite website.
Go to his outlook VBA