我正在尝试通过在电子邮件正文中链接电子表格上的某些数据的宏发送电子邮件。我写了以下内容并且它运行但它没有做任何事情。希望有人能说明这个问题：
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
答案 0 :(得分：0)
我认为您尝试这样做的方式可能不是最好的方式。虽然，我只是查看并“清理”了您的代码，使其更加“轻巧”。
在您的代码中，subj = Sheet1.Cells(x, 2) 等于 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
答案 1 :(得分：0)
我将自己的子程序放在一起用于发送电子邮件，因为我在多个过程中使用它 - 它将电子邮件的制作（创建正文、附件、选择地址等）与实际的详细发送操作分开。
我的代码如下：
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
如果你把它放在你的模块中，那么你的子程序就会减少到如下所示：
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
在优化时，我注意到您设法将 " & data2 &" 括在电子邮件正文中的引号中，也许这就是问题所在？也不确定为什么你有变量 Header8 和 data8 除非你在其他地方使用它们？你会注意到我将所有其他变量都简化为数组。
试一试，让我知道它是否有效