[[20230811193143]]　『Excelリストからメール作成』（Jessy）　ページの最後に飛ぶ

『Excelリストからメール作成』（Jessy）

こんばんは。
マクロは検索と記録を使いながら何とか使えるレベルのものです。

手元に下記のようなExcelの表があります。

 A        B     C      D    E     F     G
番号      氏名   メール  品名   色   数量   期日 
 .        .     .      .    .     .     .
 .        .     .      .    .     .     .
 .        .     .      .    .     .     .

この表からOutlookでリマインドメールを出したいのですが
大変件数があるためマクロで出来たらいいなと思いかきこみました。

Outlookでテンプレートを作りそれを開くところまではマクロ出来ています。

『やりたいこと』
そのテンプレートの中に
1.B列の氏名を先頭に入力
2.C列のメールを宛先を入力
3.本文中の決まった場所にD列~F列を表にして挿入。その際、タイトル行も入れたい。(D1~F1)
4.本文中の決まった箇所にGの期日を入力

以上4点が希望です。
どんなコードを書いたら良いかどうにかご教示頂けますでしょうか？

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

一案で～す。送信処理まで出来ているなら。(*^^*)
おすきなよ～に、テキストファイルに、書込んで
変数に一括読込してボディとかに設定、必要なだけ繰り返す！
（＾◇＾）ｖ
とか、すれば良いのでは。。。と、思いますです。
思うだけで、すみませ～ん。。。＾＾；。m(__)m
（隠居Z） 2023/08/11(金) 20:43:17

■１
＞Outlookでテンプレートを作りそれを開くところまではマクロ出来ています。

 ばれてまずい部分はダミーにして、まずはそれを提示できませんが？

■２
＞1.B列の氏名を先頭に入力
＞2.C列のメールを宛先を入力
＞3.本文中の決まった場所にD列~F列を表にして挿入。その際、タイトル行も入れたい。(D1~F1)
＞4.本文中の決まった箇所にGの期日を入力

 いずれも↓が参考になるかもしれません。（３はちょっと微妙）
[[20230517083855]]　『EXCELのシートからデータを読み取ってOUTLOOKの下書きに保存したい』（超素人なぼくちゃん）

（もこな２） 2023/08/11(金) 20:50:07

以前に作成した物が有りましたのでちょい変。＾＾；
してみました。
他にスマートな方法があるとは存じますが。。。
ご勘案の砌、何かの足しにでも。←アウトルックに関連するエラー対策は
不完全な為、別途考案してください。お役に立たなければゴミ箱ぽ～いぃ
お願い致しますぅ。。。(￣▽￣)
でわ
シート名　LIST

     |[A] |[B] |[C]           |[D] |[E]      |[F] |[G]     
 [1] |番号|氏名|メール        |品名|色       |数量|期日    
 [2] |   1|nm1 |dummy@iz.false|X1  |red      |  10|2023/8/1
 [3] |   2|nm2 |dummy@iz.false|X2  |blue     |  15|2023/8/2
 [4] |   3|nm3 |dummy@iz.false|X3  |buluck   |  20|2023/8/3
 [5] |   4|nm4 |dummy@iz.false|X4  |orange   |  25|2023/8/4
 [6] |   5|nm5 |dummy@iz.false|X5  |tomato   |  30|2023/8/5
 [7] |   6|nm6 |dummy@iz.false|X6  |yellow   |  35|2023/8/6
 [8] |   7|nm7 |dummy@iz.false|X7  |burown   |  40|2023/8/7
 [9] |   8|nm8 |dummy@iz.false|X8  |darkski  |  45|2023/8/8
 [10]|   9|nm9 |dummy@iz.false|X9  |deepgreen|  50|2023/8/9

 Option Explicit
Sub OneInstance()
    Const MySign As String = "署名　Harahore     Hare2023!"
    Dim Mi            As Object
    Dim Ml            As Object
    Dim Mfd           As Object
    Dim Ns            As Object
    Dim Mitem         As Object
    Dim Fs            As Object
    Dim Mf            As Object
    Dim r             As Range
    Dim Docs          As String
    Dim i             As Long
    Dim j             As Long
    On Error GoTo StepE
    With Worksheets("LIST")
        Set r = .Cells(1).CurrentRegion
    End With
    If r.Count < 7 * 2 Then Exit Sub
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Not olapchk(Ml) Then Set Ml = CreateObject("Outlook.Application")
    Set Ns = Ml.GetNamespace("MAPI")
    Set Mfd = Ns.GetDefaultFolder(4)
    For i = 2 To r.Rows.Count
        Open ThisWorkbook.Path & "\" & "Mail.html" For Output As #1
        Print #1, "<html>"
        Print #1, "<head>"
        Print #1, "<style type=""Text/css"">"
        Print #1, "div {font-size:20px; padding:1px; margin:1px;}"
        Print #1, "td,th {border:1px dotted #00aaff;text-align:center;width:100px;padding:2px 10px;font-size:16px;}"
        Print #1, "</style>"
        Print #1, "</head>"
        Print #1, "<Body>"
        '1.B列の氏名を先頭に入力
        '2.C列のメールを宛先を入力
        '3.本文中の決まった場所にD列~F列を表にして挿入。その際、タイトル行も入れたい。(D1~F1)
        '4.本文中の決まった箇所にGの期日を入力
        Print #1, "<br>" & r(i, 2) & Chr(32) & "様"
        Print #1, "<div>　</div>"
        Print #1, "<table><tr>"
        For j = 4 To r.Columns.Count - 1
            Print #1, "<td>" & r(1, j) & "</td>"
        Next
        Print #1, "</ tr><tr>"
        For j = 4 To r.Columns.Count - 1
            Print #1, "<td>" & r(i, j) & "</td>"
        Next
        Print #1, "</tr></table>"
        Print #1, "<div>" & r(i, 7) & "</div>"
        Print #1, "<pre><div>" & MySign & "</div></pre>"
        Print #1, "</body>"
        Print #1, "</html>"
        Close #1
        'ForReading = 1
        Set Mf = Fs.OpenTextFile(ThisWorkbook.Path & "\Mail.html", 1)
        Docs = Mf.ReadAll
        Mf.Close
        Mfd.Display
        'olMailItem = 0
        Set Mitem = Ml.CreateItem(0)
        With Mitem
            .To = r(i, 3)
            .Subject = r(i, 2)
            'olFormatHTML = 2
            .BodyFormat = 2
            .HTMLBody = Docs
            .Send
        End With
        Set Mitem = Nothing
    Next
    Kill ThisWorkbook.Path & "\" & "Mail.html"
    '送信トレイ
    Set Mi = Mfd.Items
    Do While Mi.Count > 0
        DoEvents
    Loop
    Ml.Quit
    Set Mi = Nothing
    Set Mf = Nothing
    Set Ml = Nothing
    Set Mfd = Nothing
    Set Ns = Nothing
    Set Fs = Nothing
    Set r = Nothing
    Exit Sub
StepE:
    MsgBox "原因不明のエラーです。確認後再起動してください。" & _
           Err.Number & " : " & Chr(13) & Err.Description, vbCritical, "VBA-ERRMSG"
    If olapchk(Ml) Then
        Ml.Quit
    End If
    Set Mi = Nothing
    Set Mf = Nothing
    Set Ml = Nothing
    Set Mfd = Nothing
    Set Ns = Nothing
    Set Fs = Nothing
    Set r = Nothing
End Sub
Private Function olapchk(ol As Object) As Boolean
    olapchk = True
    On Error Resume Next
    Set ol = GetObject(, "Outlook.Application")
    If ol Is Nothing Then
        olapchk = False
    End If
    On Error GoTo 0
End Function
（隠居Z） 2023/08/12(土) 13:01:58

 ちょっと確認です。
 1. Excelの表を図形にしたものを貼り付ければいいんですか？
    それとも、Wordの表のようなものでないといけないのですか？
 2. 期日(G列)も表のなかに入れたらマズイのですか？
    氏名でフィルタを掛けたとき、期日は一種類しかないんですか？
    もし複数があったら、本文にはどう反映するんですか？

（xyz） 2023/08/12(土) 14:27:03

コメント返信：

[ 一覧(最新更新順) ]

[[20230811193143]] 『Excelリストからメール作成』（Jessy） ページの最後に飛ぶ

[[20230811193143]]　『Excelリストからメール作成』（Jessy）　ページの最後に飛ぶ