Send email macro - vba

Question

I am trying to send an email through a macro linking in the email body certain data on the spread sheet. I have written the following and it runs but it just does not do anything. Was hoping someone could show some light on the problem:
Sub Send_Email_4()
Dim edress As String
Dim subj As String
Dim total As String
Dim message As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim path As String
Dim lastrow As Integer
Dim x As Integer
Dim header As String
Dim header1 As String
Dim header2 As String
Dim header3 As String
Dim header4 As String
Dim header5 As String
Dim header6 As String
Dim header7 As String
Dim header8 As String
Dim data As String
Dim Data1 As String
Dim Data2 As String
Dim data3 As String
Dim data4 As String
Dim data5 As String
Dim data6 As String
Dim data7 As String
Dim data8 As String
x = 5
Do While Sheet1.Cells(x, 1) <> ""
Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.createitem(0)
edress = Sheet1.Cells(x, 1)
total = Sheetl.Cells(52, 10)
subj = Sheet1.Cells(x, 2)
header = Sheet1.Cells(4, 3)
header1 = Sheet1.Cells(4, 4)
header2 = Sheet1.Cells(4, 5)
header3 = Sheet1.Cells(4, 6)
header4 = Sheet1.Cells(4, 7)
header5 = Sheet1.Cells(4, 8)
header6 = Sheet1.Cells(4, 9)
header7 = Sheet1.Cells(4, 10)
data = Sheet1.Cells(x, 2)
Data1 = Sheet1.Cells(x, 4)
Data2 = Sheet1.Cells(x, 5)
data3 = Sheet1.Cells(x, 6)
data4 = Sheet1.Cells(x, 7)
data5 = Sheet1.Cells(x, 8)
data6 = Sheet1.Cells(x, 9)
data7 = Sheet1.Cells(x, 10)
outlookmailitem.To = edress
outlookmailitem.cc = ""
outlookmailitem.bcc = ""
outlookmailitem.Subject = subj
outlookmailitem.Body = "Dear NAFDA FS Member," & vbCrLf & _
"Results for the annual FYR 2021 growth program are as follows," & _
vbCrLf & header & " " & header1 & " " & header2 & " " & header3 & " " & header4 & " " & header5 & " " & header6 & " " & header7 & _
vbCrLf & data & " " & Data1 & " & data2 &" _
& data3 & " " & data4 & " " & data5 & _
data6 & " " & data7 & " " _
& vbCrLf & "Best Regards"
outlookmailitem.display
lastrow = lastrow + 1
EMAILS = ""
x = x + 1
Loop
End Sub

Answer 1

I think that the way you are trying to do it might not be the best way. Although, I just looked and "cleaned" your code to be more "light".
In your code you have subj = Sheet1.Cells(x, 2) equal to data = Sheet1.Cells(x, 2)!!!
Sub Send_Email_4()
Dim oApp As Object
Dim oItem As Object
Dim edress$, subj$, total$, message$, path$
Dim header$, header1$, header2$, header3$, header4$, header5$, header6$, header7$, header8$
Dim data$, data1$, Data2$, data3$, data4$, data5$, data6$, data7$, data8$
Dim x As Integer: x = 5
Do While Sheet1.Cells(x, 1) <> ""
Set oApp = CreateObject("Outlook.Application")
Set oItem = oApp.CreateItem(0)
With Sheet1
subj = .Cells(x, 2)
edress = .Cells(x, 1)
'total = .Cells(52, 10)
header = .Cells(4, 3): header1 = .Cells(4, 4): header2 = .Cells(4, 5): header3 = .Cells(4, 6)
header4 = .Cells(4, 7): header5 = .Cells(4, 8): header6 = .Cells(4, 9): header7 = .Cells(4, 10)
data = .Cells(x, 2)
data1 = .Cells(x, 4): Data2 = .Cells(x, 5): data3 = .Cells(x, 6): data4 = .Cells(x, 7)
data5 = .Cells(x, 8): data6 = .Cells(x, 9): data7 = .Cells(x, 10)
End With
oItem.To = edress
oItem.cc = ""
oItem.bcc = ""
oItem.Subject = subj
oItem.Body = "Dear NAFDA FS Member," & vbCrLf & vbCrLf
oItem.Body = oItem.Body & "Results for the annual FYR 2021 growth program are as follows," & vbCrLf & vbCrLf
oItem.Body = oItem.Body & header & " " & header1 & " " & header2 & " " & header3 & " " & header4 & " " & header5 & " " & header6 & " " & header7 & vbCrLf
oItem.Body = oItem.Body & data & " " & data1 & " " & Data2 & " " & data3 & " " & data4 & " " & data5 & " " & data6 & " " & data7 & vbCrLf & vbCrLf
oItem.Body = oItem.Body & "Best Regards"
oItem.display
x = x + 1
Loop
End Sub

Answer 2

I put together my own sub for sending emails, as I use it in multiple processes - it separates out the making of the email (creating body text, attachments, selecting to addresses etc) from the actual nitty-gritty send actions.
My code as follows:
Sub SendEmail(Optional ToAddresses As String, Optional CcAddresses As String, _
Optional BccAddresses As String, Optional Subject As String, _
Optional Body As String, Optional AttachFiles As Variant = False, Optional AutoSend As Boolean = False)
'Adapted from https://www.rondebruin.nl/win/s1/outlook/bmail4.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = ToAddresses
.CC = CcAddresses
.Bcc = BccAddresses
.Subject = Subject
If Body Like "*<br>*" Then
.HtmlBody = Body
Else
.Body = Body
End If
If Not AttachFiles = False Then
If IsArray(AttachFiles) Then
For x = LBound(AttachFiles) To UBound(AttachFiles)
.Attachments.Add (AttachFiles(x))
Next
Else
.Attachments.Add (AttachFiles)
End If
End If
If AutoSend = True Then
.Send
Else
.Display
End If
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
If you put that in your module then your sub would get reduced down to something like the following:
Sub Send_Email_4()
Dim edress As String, subj As String, total As String, message As String
Dim path As String, lastrow As Integer, x As Integer
Dim header(0 to 8) As String, Data(0 to 8) as String, Body as String
x = 5
Do While Sheet1.Cells(x, 1) <> ""
edress = Sheet1.Cells(x, 1)
total = Sheetl.Cells(52, 10)
subj = Sheet1.Cells(x, 2)
For a = 0 to 7
header(a) = Sheet1.Cells(4, a + 3)
Data(a) = Sheet1.Cells(x, a + 3)
Data(0) = Sheet1.Cells(x, 2) 'because this one's out of pattern with the others.
Next
Body = "Dear NAFDA FS Member," & vbCrLf & _
"Results for the annual FYR 2021 growth program are as follows," & vbCrLf
For a = 0 to 7
Body = Body & Header(a) & " "
Next
Body = Body & vbCrLf
For a = 0 to 7
Body = Body & Data(a) & " "
Next
Body = Body & vbCrLf & "Best Regards"
Call SendEmail(ToAddresses:=edress, _
Subject:=subj, _
Body:=Body, _
AutoSend:=False)
lastrow = lastrow + 1
EMAILS = ""
x = x + 1
Loop
End Sub
While optimising that I noticed you'd managed to enclose " & data2 &" in quotation marks in the email body, maybe that was the problem? Also not sure why you had variables Header8 and data8 unless you were using them somewhere else? You'll notice I reduced all those other variables down to arrays.
Give it a try and let me know if it works