一、创建类似下面的excel表格，并且保存
二、创建word
1、邮件—》选择联系人—》使用现有的列表
选择第一步中创建的额excel
2、编写邮件内容
注意：上面的Title、Name这类的，只需要写入excel中的第一行的名称就可以，不能用“插入
合并项”
3、点击“开发工具”选项卡，如下图
如果没有该选项卡，按照下面的步骤来做
文件—》选项—》自定义功能区，选中“开发工具”，确定，然后就有了“开发工具”选项卡
卢洪哲
4、点击“Visual Basic”
4.1在弹出的窗口中选择“工具”—》“引用”钺怎么读
酸奶机如何做酸奶选择Microsoft Outlook 14.0 Object Library、Microsoft Excel 14.0 Object Library，确定
4.2在弹出的窗口中选择“插入”—》“模版”，输入以下代码,关闭Visual Basic窗口
Sub sendmail()
Dim xlApp As New Excel.Application
Dim oOutlookApp As Outlook.Application
Dim docSource As Document
Dim colCount As Long, rowCount As Long
Dim lRecordCount As Long, endColNo As Long
Dim bStarted As Boolean
Dim oItem As Outlook.MailItem
Dim oAccount As Outlook.Account
Dim sMySubject As String, sMessage As String, sTitle As String, sMailList As String
Dim titles
Dim titleString As String
钻石有 Dim titleColumnsCount As Long
'将当前文档设置为源文档（主文档）
Set docSource = ActiveDocument电子商务就业方向
'获取当前excel工作簿路径
sMailList = docSource.MailMerge.DataSource.Name
'检查Outlook是不是打开了。如果未打开的话，就打开新的Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'打开保存有客人的邮件地址和需要发送的附件的路径的excel文档。
Dim wb As Excel.Workbook
那天离开你留下几个字给你是什么歌 Set wb = xlApp.Workbooks.Open(sMailList)
xlApp.Visible = Flase
'设置发送邮件的账户（账户必须已经在Outlook中设置好了）
Set oAccount = oOutlookApp.Session.Accounts.Item("***********************")
'显示一个输入框，询问并让用户输入邮件主题
sMessage = "请为要发送的邮件输入邮件主题。"
'获取需要发送的邮件数，列数，并将当前节置为第一条记录
lRecordCount = wb.Sheets("Sheet1").Cells(1, 1).CurrentRegion.Rows.Count
endColNo = wb.Sheets("Sheet1").Cells(1, 1).CurrentRegion.Columns.Count
'获取到表格中表头名称
For titleColumnsCount = 1 To endColNo
titleString = titleString + wb.Sheets("Sheet1").Cells(1, titleColumnsCount) + ";"
Next titleColumnsCount
titleString = Left(titleString, Len(titleString) - 1)
titles = Split(titleString, ";")
docSource.MailMerge.DataSource.ActiveRecord = wdFirstRecord
'第一列为表头，需跳过
For rowCount = 2 To lRecordCount
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.SendUsingAccount = oAccount
'设置主题
.Subject = wb.Sheets("Sheet1").Cells(rowCount, 2)
'将标签替换为内容
titleString = docSource.Sections(1).Range.Text
For titleColumnsCount = LBound(titles) To UBound(titles)
titleString = Replace(titleString, titles(titleColumnsCount), wb.Sheets("Sheet1").Cells(rowCount, titleColumnsCount + 1))
Next titleColumnsCount
.Body = titleString
'如果excel数据结构发生改变，那么请修改此次email地址所在列数，默认为3
.To = wb.Sheets("Sheet1").Cells(rowCount, 3)
'如果excel数据结构发生改变，那么请修改此次附件地址所在列数，默认为4
For colCount = 4 To endColNo
.Attachments.Add Trim(wb.Sheets("Sheet1").Cells(rowCount, colCount))
Next colCount
'发送 or 仅显示 or 保存草稿箱，重要邮件，推荐使用 .Display模式，确认后点击发送即可
.Send
'.Display
'.Save
End With
Set oItem = Nothing
docSource.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next rowCount
xlApp.Quit
MsgBox "共发送了 " & lRecordCount - 1 & " 封邮件。"
'清空Outlook实例
Set oOutlookApp = Nothing
Set xlApp = Nothing
End Sub
5、在“开发工具”选项卡下，点击“宏”，选中sendmail，点击“执行”，就可也啦
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论