我想从Excel中通过MS Outlook发送自动邮件 .
问题是写邮件的正文 . 我在Excel单元格中为每个员工提供了一个单独的Word文件,并带有指向它的超链接 . 我想打开Word文件并以相同的格式复制Word文档中的所有内容然后粘贴到邮件正文中 .
在我的Excel工作簿中,列A到E如下所示 .
A栏:员工姓名
B列:邮件ID
C列:CC邮件ID
D栏:主题
E列:Word文件的超链接(需要打开文档以复制并粘贴到邮件正文中)
F列到Z列:附件(任何类型的附件)
Sub Send_Files()
'Make a list in Sheets("Sheet1") with :
'In column A : Names of the people
'In column B : E-mail addresses
'In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)
'The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
'and file name(s) in column C:Z it will create a mail with this information and send it.
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("F1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.cc = cell.Offset(0, 1).Value
.Subject = cell.Offset(0, 2).Value
.Body = "Hi" & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If[enter link description here][1]
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
快照拍摄邮件内容的正文 .
1 回答
诀窍是获取粘贴格式的Word文档内容 . 为此,您需要附加MS Word是Outlook邮件项的编辑器 .
此外,从上面的示例Word文档中,您希望为用户个性化电子邮件 . 因此,将Word文档修改为“Dear XXXNAMEXXX”,然后执行查找/替换(如代码所示) .