メール送信用スクリプト

それと処理が完了した後でメールが飛ばしたいというのも有ったので
メール 送信用スクリプト
いろんな人が作っているので今更感があるものの。
念のため保管。Gmailを送信エンジンに使うのもどうかなという気がするけど
SSL対応してない某社メールサーバが悪いということで

Function CompMailSend(val_keyNo,val_Path)

    Dim argRtn(2)        '引数チェック用   
    Dim objFso            'ファイル存在チェック用

    Dim objExcel
    Dim xlSheet
    Dim keyNO           
    Dim excelPath       
    Dim i           
    Dim LastRow        
    Dim matchnum        '対象EXCEL行数確保用
    Dim KeyCell           
    Dim CellValue       
    Dim strEmpCol   
    strEmpCol ="X"         'EXCEL列
    Dim empdateColum        'EXCEL列
    empdateColum ="X"        
    Dim InedepColumn        'EXCEL列
    InedepColumn ="X"        
    Dim TargetRow        '対象行
   
    Dim MailRowValue   
    Dim MailEmpDValue   
    Dim MailindepValue   

    Dim oMsg                'メールオブジェクト
    Dim strConfigurationField
    Dim strBodymsg            'メール本文用
    Dim mailUser            '
    Dim mailpass            '
    Dim smtpserver            'SMTPサーバ
    Dim smtpport            'SMTPポート
    Dim memberto                '送信先
   
    strConfigurationField="http://schemas.microsoft.com/cdo/configuration/"
    'Gmailを使用
    mailUser="XXX"           
    mailpass="XXX"           
    smtpserver="smtp.gmail.com"
    smtpport="465"
    '宛先追加の場合は下記を追加
    memberto="XXX,"
    memberto=memberto & "XXX,XXX"
 
  '/* 引数エラーチェック
    argRtn(0)= argumentChecker(val_keyNo)
    argRtn(1)= argumentChecker(val_Path)
   
    If argRtn(0) ="False" Or argRtn(1) ="False" Then
        CompMailSend = "False"
        Logrtn = OutLogger("[Err],EXCELパスが空白です。")
        If Logrtn = "False" Then
            WScript.Echo LErrMsg
        End If
        Exit Function
    Else
        keyNO = val_keyNo
        excelPath = val_Path
    End If
   
    'ファイル存在チェック
    Set objFso = CreateObject("Scripting.FileSystemObject")
    If objFso.FileExists(excelPath) Then
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Workbooks.Open(excelPath)
        Set xlSheet = objExcel.Worksheets(1)
        objExcel.Visible = False
    Else
        CompMailSend="False"
        Logrtn = OutLogger("[Err],EXCELファイルが存在しません。")
        If Logrtn = "False" Then
            WScript.Echo LErrMsg
        End If
        Exit Function
    End If
   
    LastRow = xlSheet.UsedRange.Rows.Count    'EXCEL最終行取得
   
    For i = 1 To LastRow Step 1
        'KeyNoと比較してヒットするものの行数を取得
        KeyCell = strEmpCol & i
        CellValue = xlSheet.Range(KeyCell).Value
        If keyNO = CellValue Then
            matchnum = i
            Exit For
        End If
    Next
   
    If keyNO <> CellValue Then
        objExcel.DisplayAlerts = False
        objExcel.Application.Quit       
        CompMailSend="False"
        Exit Function
    End If
   
    'メールテンプレート文言用変数にEXCELから取得したそれぞれの値をセット
    MailRowValue=i
    TargetRow = empdateColum & matchnum
    MailEmpDValue=xlSheet.Range(TargetRow).Value
    TargetRow = ""
    TargetRow = InedepColumn & matchnum
    MailindepValue=xlSheet.Range(TargetRow).Value
   
    'メール本文生成
    strBodymsg= strBodymsg & "宛先" & vbCrLf
    strBodymsg= strBodymsg & vbCrLf
    strBodymsg= strBodymsg & "お疲れ様です。" & vbCrLf
    strBodymsg= strBodymsg & "EXCELを更新しました。" & vbCrLf
    strBodymsg= strBodymsg & vbCrLf
    strBodymsg= strBodymsg & excelPath & vbCrLf
    strBodymsg= strBodymsg & vbCrLf
    strBodymsg= strBodymsg & "A列" & MailRowValue & "行目" & vbCrLf 
    strBodymsg= strBodymsg & "値  ：" & MailEmpDValue & vbCrLf
    strBodymsg= strBodymsg & "値：" & MailindepValue & vbCrLf
    strBodymsg= strBodymsg & vbCrLf
    strBodymsg= strBodymsg & vbCrLf
    strBodymsg= strBodymsg & "==============================="  & vbCrLf
    strBodymsg= strBodymsg & "送信日時:" & Now & vbCrLf
    strBodymsg= strBodymsg & "このお知らせは送信専用メールアドレスから配信されています。"  & vbCrLf
    strBodymsg= strBodymsg & "このアドレスに返信しないでください。"
   
    'メール送信
    Set oMsg = CreateObject("CDO.Message")
    oMsg.From = "XXX"
    oMsg.To = memberto
    oMsg.Subject = "タイトル"
    oMsg.TextBody = strBodymsg
   
    With oMsg.Configuration.Fields
        .Item(strConfigurationField & "sendusing") = 2
        .Item(strConfigurationField & "smtpserver") = smtpserver
        .Item(strConfigurationField & "smtpserverport") = smtpport
        .Item(strConfigurationField & "smtpauthenticate") = 1
        .Item(strConfigurationField & "sendusername") = mailUser
        .Item(strConfigurationField & "sendpassword") = mailpass
        .Item(strConfigurationField & "smtpconnectiontimeout") = 60
        .Item(strConfigurationField & "smtpusessl") = True           
        .Update
    End With
    oMsg.Send
   
    'EXCELを終了
    objExcel.DisplayAlerts = False
    objExcel.Application.Quit       
    CompMailSend="True"
   
End Function