戻る

一太郎での「差し込み印刷」のような機能をもったメール送信の仕組みをExcelで実現します（Excelを使って複数の宛先に対してメールの一括送信を行います）。

本文には「%1%」や「%3%」等の置換文字をを使って宛先ごとに内容をコントロールすることもできます。
メール送信にはBSMTP.DLLを使っています。ここからBASP21をダウンロードしてインストールするか、BSMTP.DLLのみWindows\Systemディレクトリにコピーしてください。

ダウンロードはここ

Option Explicit
Declare Function SendMail Lib "bsmtp" _
      (szServer As String, szTo As String, _
       szFrom As String, szSubject As String, szBody As String, szFile As String) As String
Sub MySendMail()
    Dim ret As String
    Dim szLogfile As String
    Dim szServer As String, szTo As String, szFrom As String
    Dim szSubject As String, szBody As String, szFile As String
    Dim flBody
    Dim i As Long
    Dim fs, a As Object
    On Error GoTo Err_Handler
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("c:\log.txt", True)
    ' メール送信結果を記録するファイル名を指定します。
    szServer = Worksheets("本文").Cells(11, 1) ' SMTPサーバ名
    '
    With Worksheets("宛名及び置換文字")
    If .Cells(1, 3) & .Cells(1, 7) = "" Then
        MsgBox "タイトルとＦＲＯＭを入力してください"
        GoTo Exit_sub
    Else
        If MsgBox("タイトル：" & .Cells(1, 3) & "、送信元" & .Cells(1, 7) & "で良いですか？", _
            vbOKCancel, "確認") = vbCancel Then
            GoTo Exit_sub
        End If
    End If
    szSubject = .Cells(1, 3)    ' 件名
    szFrom = .Cells(1, 7)   ' 送信元
    i = 3
        Do While .Cells(i, 1) <> "END"
            If .Cells(i, 1) = "○" Then
                szTo = .Cells(i, 5)    ' 宛先
                szBody = .Cells(i, 6) ' 本文
                szFile = ""
                ret = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile)
                If Len(ret) <> 0 Then
                    a.WriteLine (Date & " " & Time & " " & ret & "−" & szTo & "−" & szBody)
                    'MsgBox "エラー" & ret & "−" & .Cells(i, 4)
                    .Cells(i, 1) = "エラー"
                Else
                    .Cells(i, 1) = "完了"
                End If
            End If
            i = i + 1
        Loop
    End With
    ' パラメータエラーのときは、戻り値にエラーメッセージが返ります。
    
    MsgBox "終了"
    GoTo Exit_sub

Err_Handler:
    MsgBox Err.Description, vbCritical, "Error"
    GoTo Exit_sub

Exit_sub:
    a.Close
End Sub

（宛名リスト）

（本文の入力）