Need Help Creating Macro to send email with multiple lines in excel...

[liferg]

Hi,

I am wanting to create a macro to help me send only one email out. I can currently send out an email if there is only one line, but there are instances where there are multiple lines involved, but I do not want it to send out multiple emails only one. So there sometimes could be two lines or it might be five or six lines. I am not sure how to attach a sample of the data, but below is currently the code I am using:

c/Sub InvoiceEmails()
Dim i As Integer ' Counter
Dim strTo As String ' Email To
Dim strCC As String ' Email CC
Dim strSubject As String ' Email Subject
Dim strBody As String ' Email Body
Dim intLastRow As Integer 'Number of rows to process
Const testMode As Integer = 0 ' 1 runs creates 1 email. Anything else creates all emails
Dim Signature As String

'Find the number of rows
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
intLastRow = Selection.Rows.Count + 1
' Loop through rows
i = 2
For i = 2 To intLastRow
strTo = Cells(i, 14).Value
strCC = Cells(i, 15).Value
strSubject = "Sales Transaction Info-Store# " & Cells(i, 7).Value & "-" & Cells(i, 2).Value & " Invoice# " & Cells(i, 3).Value
strBody = "<table width='75%'>"
strBody = strBody & " </tr>"
strBody = strBody & "<font face=Calibri>"
strBody = strBody & "<font size=2>"

strBody = strBody & "Hello " & Cells(i, 17) & ","
strBody = strBody & " " & "<br>"
strBody = strBody & " " & "<br>"
strBody = strBody & "We have received an invoice from " & Cells(i, 2).Value & " for " & Cells(i, 8).Value & " of Sku# " & (Cells(i, 9).Value) & " described as " & (Cells(i, 10).Value) & " and ordered under PO #" & (Cells(i, 4).Value)
strBody = strBody & ". <b> Please provide the sales transaction details for this order, as well as the sku# this was sold under.</b>"
strBody = strBody & " " & "<br>"
strBody = strBody & " " & "<br>"
strBody = strBody & " <b>Please reply to this email within 3 days.</b> If no reply is received then the invoice will be paid based on proof of delivery and charged to the store shrink account. "
strBody = strBody & " " & "<br>"
strBody = strBody & " " & "<br>"


Create_Email strTo, strCC, strSubject, strBody
Next

End Sub
Sub Create_Email(strTo As String, strCC As String, strSubject As String, strBody As String)
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String

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

On Error Resume Next
With OutMail
.Save
End With
Signature = OutMail.HTMLBody

With OutMail
.To = strTo
.Cc = strCC
.BCC = ""
.Subject = strSubject
.HTMLBody = strBody & Signature
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
/c

 

[liferg]

Is there any one that can help me with this issue??? Or is there no way this can be done???

 

[daverunt]

Hi,

If you mean you use several rows of cells for a single message then I use the following to create a message with that:

'Message create
    For Each Cell In Sheets("Sheet1").Range("A1:A10")
        MailBody = MailBody & Cell.Value & vbCr
    Next