Excelで一斉メール送信ソフトを作ってみよう

'送信設定値のチェック
Private Function ExDataCheck() As Boolean
    ExDataCheck = False
    If Range("I7") = "" Then
        MsgBox "SMTPサーバー名を入力してください。", , "一斉メール送信"
        Exit Function
    End If
    If Range("L7") = "" Then
        MsgBox "ポート番号を入力してください。（通常は「25」になります）", , "一斉メール送信"
        Exit Function
    End If
    If Range("I8") = "" Then
        MsgBox "送信元アドレスを入力してください。", , "一斉メール送信"
        Exit Function
    End If
    If Range("I10") = "" Then
        MsgBox "件名を入力してください。", , "一斉メール送信"
        Exit Function
    End If
    If Range("I11") = "" Then
        MsgBox "本文を入力してください。", , "一斉メール送信"
        Exit Function
    End If
    ExDataCheck = True
End Function

Private Sub CommandButton2_Click()
    Dim lrow As Long
    
    '送信設定値のチェック
    If ExDataCheck = False Then
        Exit Sub
    End If
    '送信先アドレスの最終行を調べる
    lrow = ActiveSheet.Range("D65536").End(xlUp).Row
    If lrow = 6 Then
        MsgBox "送信先アドレスは最低１件は入力してください。", , "一斉メール送信"
    End If
End Sub

下記のVBAコードに変更してください。

Private Function ExSendMail() As Boolean
    Dim sret As String
    Dim szServer As String  'SMTPサーバー名
    Dim szFrom As String    '送信元
    Dim szTo As String      '宛先
    Dim szSubject As String '件名
    Dim szBody As String    '本文
    Dim szFile As String    '添付ファイル
    
    ExSendMail = False
    szServer = Range("I7") & ":" & Range("L7")
    If Range("I6") = "" Then
        szFrom = Range("I8")
    Else
        szFrom = Range("I6") & "<" & Range("I8") & ">"
    End If
    szTo = Range("I8")
    szSubject = Range("I10")
    szBody = Range("I11")
    szFile = ""
    
On Error GoTo ErrEnd
    sret = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile)

    ' 送信エラーの場合
    If Len(sret) <> 0 Then
        MsgBox "送信エラー： " & sret, , "一斉メール送信"
    Else
        ExSendMail = True
    End If
    Exit Function
ErrEnd:
    MsgBox "送信中にエラーが発生しました。" & vbCrLf & Err.Description, , "一斉メール送信"
End Function

Private Sub CommandButton1_Click()
    If ExDataCheck = False Then
        Exit Sub
    End If
    
    If ExSendMail Then
        MsgBox "正常に送信できました。", , "一斉メール送信"
    End If
End Sub