[算表] E-mail 批次郵件寄送不同附件to不同人

[zmail (ZM)]

軟體:
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: 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("工作表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

範例圖片：https://imgur.com/i97MD9k.jpg
收件者收到的畫面:https://imgur.com/NfJDAKm.jpg
------------------------

關鍵字：合併列印 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