VB6リファレンスメール送信 (BASP21)

VB6 メール送信 (BASP21)

BASP21.DLL を使ってメール送信を行います

BASP21.DLL が必要です。 Download

お品書き

● サンプル	Basp21を使うための宣言と共通関数定義の標準モジュール
● サンプル	共通関数を使ったメール送信(プロバイダ経由)のサンプルプログラム例
● サンプル	共通関数を使ったメール送信(社内メールサーバ経由)のサンプルプログラム例

▲TOP

● Basp21を使うための宣言と共通関数定義の標準モジュール

'=========================================
' BASP21 API 定義
'=========================================
Public 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

Public Declare Function Version Lib "bsmtp" () As String

Public Declare Function RcvMail Lib "bsmtp" _
         (szServer As String, szUser As String, szPass As String, _
         szCommand As String, szDir As String) As Variant

'=========================================
' POP before SMTP 共通関数
' 書式 result = BASP21_POPBeforeSMTP( POP3サーバ名, メールアカウント名, パスワード )
' 戻り値 0:成功 -1:失敗
'=========================================
Public Function BASP21_POPBeforeSMTP(POPSERVER As String, _
         MAILACCOUNT As String, _
         MAILPASSWORD As String ) As Long

     Dim ar As Variant

     ar = RcvMail(POPSERVER, MAILACCOUNT, MAILPASSWORD, "STAT", App.Path)
     If (Not IsArray(ar)) Then
         BASP21_POPBeforeSMTP = -1     '認証失敗
         Exit Function
     End If

     BASP21_POPBeforeSMTP = 0     '正常終了

End Function

'=========================================
' SENDMAIL 共通関数
' 書式 result = BASP21_SENDMAIL( SMTPサーバ名, メアド(TO), メアド(CC), メアド(BCC), メアド(送信元), 件名, 本文, 添付ファイル名 )
' ※複数のメールアドレスがある場合はセミコロン(;)区切りでつなげてください。省略時は ""。
' 戻り値 0:成功 -1:失敗
'=========================================
Public Function BASP21_SENDMAIL( _
            szServer As String, _
            szTo As String, _
            szCC As String, _
            szBCC As String, _
            szFrom As String, _
            szSubject As String, _
            szBody As String, _
            Optional szFile As String = "" ) As Long

     BASP21_SENDMAIL = -1

     'TO と CC と BCC を BASP21仕様文字列へ変換
     Dim wkTO As String
     wkTO = BASP21_MAKE_TO(szTo, szCC, szBCC)
     If (wkTO = "") Then Exit Function

     'メール送信
     Dim Ret As String
     Ret = SendMail(szServer, wkTO, szFrom, szSubject, szBody, szFile)
     If (Ret <> "") Then Exit Function

     BASP21_SENDMAIL = 0

End Function

'===============
' SENDMAIL用内部関数
'===============
Public Function BASP21_MAKE_TO( _
            strTO As String, _
            Optional strCC As String = "", _
            Optional strBCC As String) As String
     Dim i As Long
     Dim ary() As String
     Dim wkTO As String
     Dim wkRet As String: wkRet = ""
     If (strTO = "") Then
         BASP21_MAKE_TO = ""
         Exit Function
     End If

     wkTO = strTO
     If (strCC <> "") Then
         wkTO = wkTO & ";" & "cc" & ";" & strCC
     End If
     If (strBCC <> "") Then
         wkTO = wkTO & ";" & "bcc" & ";" & strBCC
     End If

     wkTO = StrConv(wkTO, vbNarrow)     '全角あれば半角へ

     ary = Split(wkTO, ";")
     For i = 0 To UBound(ary)
         If (Trim(ary(i)) <> "") Then
             If (wkRet = "") Then
                 wkRet = Trim(ary(i))
             Else
                 wkRet = wkRet & vbTab & Trim(ary(i))     'BASP21はタブ区切り
             End If
         End If
     Next

     BASP21_MAKE_TO = wkRet

End Function

▲TOP

● 共通関数を使ったメール送信(プロバイダ経由)のサンプルプログラム

'==============
' メール送信サンプル
'==============
Private Sub Sample()
    Dim result As Long

    ' POP before SMTP 用変数
    Dim PopServer as String     ' プロバイダ POP3サーバ名
    Dim MailAccount as String   ' プロバイダメールアカウント名
    Dim Password as String      ' プロバイダメールパスワード

    'メール送信用変数
    Dim SmtpServer as String   ' SMTPサーバ名(IPアドレス)[:ポート番号] ※ポート省略時は 25
    Dim To As String               ' To (複数の場合は、セミコロン区切り)
    Dim CC As String              ' CC (複数の場合は、セミコロン区切り、ないときは "")
    Dim BCC As String            ' BCC (複数の場合は、セミコロン区切り、ないときは "")
    Dim FROM As String          ' 送信元各メアドはこんな感じもOK → "Tatsuya <tatsuya@red.oit-net.jp>"
    Dim Body As String           ' メール本文
    Dim Subject As String       ' メール件名
    Dim SendFile As String      ' 添付ファイル名(複数ある時はタブ(vbTab)区切り、ないときは "")

    PopServer = "pop3.provider.jp"
    MailAccount = "tatsuya"
    Password = "himitsu"

    SmtpServer = "smtp.provider.jp:587"
    To = "aaa@xxxxx.jp"
    CC = "Bさん <bbb@xxxxx.jp>;Cさん <ccc@xxxxx.jp>"
    BCC = "ddd@xxxxx.jp;eee@xxxxx.jp"
    FROM = "Tatsuya管理人 <tatsuya@red.oit-net.jp>"
    Subject = "はじめまして"
    Body = "こんにちは" & vbCrLf & "よろしくお願いします"
    SendFile = "c:¥temp¥aaa.zip" & vbTab & "c:¥temp¥bbb.zip"

    '------------------------------
    ' BASP21 POP before SMTP
    '------------------------------
    result = BASP21_POPBeforeSMTP(PopServer, MailAccount, Password)
    If (result <> 0) Then
        MsgBox "POP before SMTP に失敗しました", vbCritical, "認証失敗"
        Exit Sub
    End If

    '--------------
    ' メール送信
    '--------------
    result = BASP21_SENDMAIL(SmtpServer, To, CC, BCC, FROM, Subject, Body, SendFile)
    If (result <> 0) Then
        Msgbox "メール送信に失敗しました。", vbCritical, "メール送信エラー"
        Exit Sub
    End If
End Sub

▲TOP

● 共通関数を使ったメール送信(社内メールサーバ経由)のサンプルプログラム

'==============
' メール送信サンプル
'==============
Private Sub Sample()
    Dim result As Long

    'メール送信用変数
    Dim SmtpServer as String   ' SMTPサーバ名(IPアドレス)[:ポート番号] ※ポート省略時は 25
    Dim To As String               ' To (複数の場合は、セミコロン区切り)
    Dim CC As String              ' CC (複数の場合は、セミコロン区切り、ないときは "")
    Dim BCC As String            ' BCC (複数の場合は、セミコロン区切り、ないときは "")
    Dim FROM As String          ' 送信元各メアドはこんな感じもOK → "Tatsuya <tatsuya@red.oit-net.jp>"
    Dim Body As String           ' メール本文
    Dim Subject As String       ' メール件名
    Dim SendFile As String      ' 添付ファイル名(複数ある時はタブ(vbTab)区切り、ないときは "")

    SmtpServer = "smtp.kaisya.co.jp"
    To = "aaa@kaisya.co.jp"
    CC = "bbb@kaisya.co.jp;ccc@kaisya.co.jp"
    BCC = ""
    FROM = "tatsuya@kaisya.co.jp"
    Subject = "お疲れ様です"
    Body = "仕事を添付します。" & vbCrLf & "よろしくお願いします"
    SendFile = "c:¥temp¥aaa.zip"

    '--------------
    ' メール送信
    '--------------
    result = BASP21_SENDMAIL(SmtpServer, To, CC, BCC, FROM, Subject, Body, SendFile)
    If (result <> 0) Then
        Msgbox "メール送信に失敗しました。", vbCritical, "メール送信エラー"
        Exit Sub
    End If
End Sub

▲TOP