添加链接
link管理
链接快照平台
  • 输入网页链接,自动生成快照
  • 标签化管理网页链接

输入VBA代码:

Private Sub 按钮1_Click() '对按钮进行编程 复制下面的代码

'要能正确发送并需要对Microseft Outlook进行有效配置

On Error Resume Next

Dim rowCount, endRowNo

Dim objOutlook As New Outlook.Application

Dim objMail As MailItem

Dim Signature As String

'取得当前工作表与Cells(1,1)相连的数据区行数

endRowNo = Application.WorksheetFunction.CountIfs(Range("A:A"), "<>")

'创建objOutlook为Outlook应用程序对象

Set objOutlook = New Outlook.Application

'开始循环发送电子邮件,比如从第二行开始,第一行是标题

For rowCount = 2 To endRowNo

Set objMail = objOutlook.CreateItem(olMailItem) '创建objMail为一个邮件对象

Body = "<H3><B>你好:</B></H3>" & _

"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX<br>" & _

"<br><br><B></B>" & _

GetSignature()

With objMail

.To = Cells(rowCount, 1).Value '设置收件人地址(从Excel表的第一列"邮件地址"字段中获得)

.CC = Cells(rowCount, 2).Value '设置抄送人地址(从Excel表的第二列"邮件地址"字段中获得)

.Subject = Cells(rowCount, 3).Value & Year(Now) & "年" & Month(Now) & "月" '设置邮件主题(从Excel表的第三列"邮件主题"字段中获得)并记录年月

.HTMLBody = Body

'.HTMLBody = Cells(rowCount, 4).Value '设置邮件内容(从Excel表的第四列"邮件内容"字段中获得)

.Attachments.Add Cells(rowCount, 5).Value '设置附件(从Excel表的第五列"附件"字段中获得)

.Send

End With

Set objMail = Nothing '销毁objMail对象

Next

MsgBox ("邮件全部发送完成!")

Set objOutlook = Nothing '销毁objOutlook对象

End Sub

'提取邮件签名子函数

Public Function GetSignature()

Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")

SigPath = "C:\Users\xxxxx\AppData\Roaming\Microsoft\Signatures\IT.htm"

Set f_SignatureObj = fso.OpenTextFile(SigPath, 1, False, 0)

GetSignature = f_SignatureObj.ReadAll

f_SignatureObj.Close

Set fso = Nothing

End Function