Sub Send_Files() 'Working in Excel 2000-2016 'For Tips see: https://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("工作表1")
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("C1:Z1")
If cell.Value Like "?*@?*.?*" And _ Application.WorksheetFunction.CountA(rng) > 0 Then Set OutMail = OutApp.CreateItem(0)
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 Next cell
Set OutApp = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub
outlook 發 給多人 在 [算表] E-mail 批次郵件寄送不同附件to不同人- 看板Office 的推薦與評價
軟體:
excel 2016
outlook 2016
說明：
可批次郵寄寄信(Excel版的合併列印)，
給不同的使用者、不同的附件，
如寄送個人成績單..等，
Ａ會收到Ａ成績單
Ｂ會收到Ｂ成績單
一次寄送多筆(如50筆以上手動寄信太麻煩，可參考此方法)
寄送前確認你的信箱不會被當成垃圾信，
如收件人未收到，
請收件人去垃圾郵件找看看。
如要直接改範例，請至文末(3)處下載後改即可。
(1)----空白excel建立方式------------
一.先登入outlook，預設outlook信箱，
會成為excel批次合併列印附件之寄件信箱
二.
1.開啟EXCEL＝＞插入＝＞模組
2.在Module1貼上[程式碼](參閱下方)。
3.Alt+Q返回 Excel。
4.
A1~A99..欄寫【收件者姓名】
B1~B99..欄寫【收件者Email】
C1~C99..欄寫【附件在電腦內的路徑】
5.您可以使用 Alt+F8然後選擇腳本並運行它。
6.excel會自動開啟outlook去寄信。
※上方為從空白試算表建立，Excel範例檔可參考文末處。
(2)----程式碼範例 -------
https://bit.ly/2TvHXr5
------------------
Option Explicit
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: https://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("工作表1")
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("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "110年成績單-"
.HTMLBody = "<H2><B>同學 " & cell.Offset(0, -1).Value & " 您好
：</B></H2>" & _
"<H3>1.收到學期成績單，當你閱讀完畢後,請記得填寫下列回覆單<br></
H3>" & _
"<H3><A HREF=""https://forms.gle/*******"">成績確認回覆單：</A><
br></H3>" & _
"<H3><A HREF=""https://forms.gle/*******"">https://forms.gle/***
****</A><br></H3>" & _
"<H3> 表示您已閱讀完畢,也可以讓老師進行最後一段畢業成績結算事宜
,謝謝您的配合!<br></H3>" & _
"<br>" & _
"<H3>2.如果對成績單有疑義的話,請來電23*******轉*** 找老師詢問.<br
></H3>" & _
"<br>" & _
"<br><br><B>Thank you</B>"
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
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
----程式碼範例----
(3)-----範例檔案與修改-------
修改email信件主旨與說明:
開啟範例Excel含巨集試算表
1.ALT+F11打開程式碼，點開模組的Module1程式碼
從With OutMail行開始改
.Subject是主旨
.HTMLBody是信件內容，要寫成HTML格式
cell.Offset(0, -1).Value 是抓A1欄姓名帶入信件內
範例Excel巨集檔案(下載後請啟用巨集)：
https://bit.ly/3vrnsci
範例圖片：
收件者收到的畫面:
------------------------
關鍵字：合併列印 Email 郵件 寄送 不同附件 薪資單 成績單
參考網頁：
https://www.rondebruin.nl/win/s1/outlook/amail6.htm
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 118.167.183.177 (臺灣)
※ 文章網址: https://www.ptt.cc/bbs/Office/M.1623750385.A.72D.html
※ 編輯: zmail (118.167.183.197 臺灣), 06/22/2021 00:54:39
... <看更多>