这是我现在的代码
Sub 按钮3_Click()
'对按钮进行编程
'要能正确发送并需要对Microsoft Outlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo, cloCount As Integer
Dim objOutlook As Outlook.Application
Dim objMail As MailItem
Dim Signature As String
Dim strFirstParagraph As String
Dim strSecondParagraph As String
Dim strHTMLBody As String
'取得当前工作表与Cells(1,1)相连的数据区行数
endRowNo = Application.WorksheetFunction.CountA(Rows(1)) - 1
'创建objOutlook为Outlook应用程序对象
Set objOutlook = New Outlook.Application
For rowCount = 2 To endRowNo '开始循环发送电子邮件,比如从第二行开始,第一行是标题
Set objMail = objOutlook.CreateItem(olMailItem) '创建objMail为一个邮件对象
With objMail
.To = Cells(rowCount, 1).Value '设置收件人地址(从Excel表的第一列"收件人"字段中获得)
.CC = Cells(rowCount, 2).Value '设置抄送人地址(从Excel表的第二列"抄送人"字段中获得)
.Subject = Cells(rowCount, 3).Value '设置邮件主题(从Excel表的第三列"邮件主题"字段中获得)并记录年月
'格式化第一段和第二段文本,并在开头空两个格
strFirstParagraph = " " & Replace(Cells(rowCount, 4).Value, vbCrLf, "<br>") ' 添加空格并处理换行
strSecondParagraph = " " & Replace(Cells(rowCount, 5).Value, vbCrLf, "<br>") ' 添加空格并处理换行
'添加问候语和正文内容
strHTMLBody = "<p>您好:</p><p>" & strFirstParagraph & "</p><p>" & strSecondParagraph & "</p>"
.HTMLBody = strHTMLBody
.Importance = 2 '设置重要性为高
'设置邮件附件(第6列为excel表格附件)
.Attachments.Add "D:\邮件附件\" & Cells(rowCount, 6).Value & ".xlsx"
'设置邮件附件(从第7列"附件"字段中获得,格式为pdf,若需要用其他格式进行修改即可)
For cloCount = 7 To 20
If Cells(rowCount, cloCount).Value <> "" Then
.Attachments.Add "D:\邮件附件\" & Cells(rowCount, cloCount).Value & ".pdf"
End If
Next cloCount
'发送邮件
objMail.Send
End With
'销毁objMail对象
Set objMail = Nothing
Next rowCount
'提示邮件发送完成
MsgBox "邮件全部发送完成!"
'销毁objOutlook对象
Set objOutlook = Nothing
End Sub
Sub 按钮3_Click()
'对按钮进行编程
'要能正确发送并需要对Microsoft Outlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo, cloCount As Integer
Dim objOutlook As Outlook.Application
Dim objMail As MailItem
Dim Signature As String
Dim strFirstParagraph As String
Dim strSecondParagraph As String
Dim strHTMLBody As String
'取得当前工作表与Cells(1,1)相连的数据区行数
endRowNo = Application.WorksheetFunction.CountA(Rows(1)) - 1
'创建objOutlook为Outlook应用程序对象
Set objOutlook = New Outlook.Application
For rowCount = 2 To endRowNo '开始循环发送电子邮件,比如从第二行开始,第一行是标题
Set objMail = objOutlook.CreateItem(olMailItem) '创建objMail为一个邮件对象
With objMail
.To = Cells(rowCount, 1).Value '设置收件人地址(从Excel表的第一列"收件人"字段中获得)
.CC = Cells(rowCount, 2).Value '设置抄送人地址(从Excel表的第二列"抄送人"字段中获得)
.Subject = Cells(rowCount, 3).Value '设置邮件主题(从Excel表的第三列"邮件主题"字段中获得)并记录年月
'格式化第一段和第二段文本,并在开头空两个格
strFirstParagraph = " " & Replace(Cells(rowCount, 4).Value, vbCrLf, "<br>") ' 添加空格并处理换行
strSecondParagraph = " " & Replace(Cells(rowCount, 5).Value, vbCrLf, "<br>") ' 添加空格并处理换行
'添加问候语和正文内容
strHTMLBody = "<p>您好:</p><p>" & strFirstParagraph & "</p><p>" & strSecondParagraph & "</p>"
.HTMLBody = strHTMLBody
.Importance = 2 '设置重要性为高
'设置邮件附件(第6列为excel表格附件)
.Attachments.Add "D:\邮件附件\" & Cells(rowCount, 6).Value & ".xlsx"
'设置邮件附件(从第7列"附件"字段中获得,格式为pdf,若需要用其他格式进行修改即可)
For cloCount = 7 To 20
If Cells(rowCount, cloCount).Value <> "" Then
.Attachments.Add "D:\邮件附件\" & Cells(rowCount, cloCount).Value & ".pdf"
End If
Next cloCount
'发送邮件
objMail.Send
End With
'销毁objMail对象
Set objMail = Nothing
Next rowCount
'提示邮件发送完成
MsgBox "邮件全部发送完成!"
'销毁objOutlook对象
Set objOutlook = Nothing
End Sub