Excelマクロ(VBA)メール送信　Outlook不要

Function Send_mail(ByVal arrMailTo As Variant, strSubject As String, strBody As String, ByVal arrAttachment As Variant) As Boolean
    '★　の部分はお使いのメールサーバ情報に変更して下さい

    'メールが正常送信の場合　True、送信できなかった場合　False　を返す
    '宛先は、一次元配列でセット
    '添付ファイルは、一次元配列でセット
    

    On Error GoTo err_Handler
    
    Dim objMessage As Object
    Dim objEmailConfig As Object
    Dim objEmailFields As Variant
    Dim recipient As String
    Dim i As Long
    
    ' 宛先アドレスの結合
    If IsArray(arrMailTo) Then
        For i = 0 To UBound(arrMailTo)
            If recipient = "" Then
                recipient = arrMailTo(i)
            Else
                recipient = recipient & ";" & arrMailTo(i)
            End If
        Next i
    End If
    
    ' メールオブジェクトの作成
    Set objMessage = CreateObject("CDO.Message")
    Set objEmailConfig = CreateObject("CDO.Configuration")
    Set objEmailFields = objEmailConfig.Fields
    
    ' SMTP構成の設定
    With objEmailFields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 '変更の必要なし
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.example.com" '★SMTPサーバーアドレス
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 '★ポート番号　通常は右のどれか　587　465 25 2525
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 '変更の必要なし
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "abc@example.com" '★ユーザ名
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "abc1234" '★パスワード
        .Item("http://schemas.microsoft.com/cdo/configuration/sendcharset") = "UTF-8" '変更の必要なし
        .Update
    End With
    
    ' メール内容の設定
    With objMessage
        Set .Configuration = objEmailConfig
        .To = recipient
        .From = "abc@example.com" '★送信元メールアドレス
        .Subject = strSubject
        .TextBody = strBody
        
        If IsArray(arrAttachment) Then
            For i = 0 To UBound(arrAttachment)
                .AddAttachment arrAttachment(i)
            Next i
        End If
        
        .Fields.Update
        .Send
    End With

    ' 正常終了
    Send_mail = True
    GoTo Cleanup

err_Handler:
    Send_mail = False

Cleanup:
    Set objMessage = Nothing
    Set objEmailConfig = Nothing
    Set objEmailFields = Nothing
    
End Function