外部ライブラリを作成してVBAでメールを送信する方法(SmtpClient使用)

sending_email_using_vba_by_dotnet_library_top

VBAでメールを送信しないといけなかったので、.NETのSmtpClientライブラリを使って、自分で外部ライブラリを作成してみました。

主に参考にしたページはこちらになります。

VBAで独自の.NETライブラリを使うには?[VB] - @IT

この例では言語はVBを使っていますので、C#などを使う場合は読み替えてください。

sending_email_using_vba_by_dotnet_library_001

まずVisual Studioを起動し、ファイル>新規作成>プロジェクトを選択します。上の画面のようにテンプレートからVisual Basic>Windows>クラスライブラリを選択します。

sending_email_using_vba_by_dotnet_library_002

メニューのツール>GUIDの作成からレジストリ形式のGUIDを作成します。コピーして、コードの中で使うので下記のコードの値を書き換えてください

コード自体は以下のようになります。

Imports System
Imports System.Net
Imports System.Net.Mail
Imports System.Text.RegularExpressions

'クラスをCOM経由でアクセス可能にする
<ComClass(SmtpClientVBA.ClassId, SmtpClientVBA.InterfaceId, SmtpClientVBA.EventsId)>
Public Class SmtpClientVBA
    'COM用のGUID値
    Public Const ClassId As String = "<独自GUID>"
    Public Const InterfaceId As String = "<独自GUID>"
    Public Const EventsId As String = "<独自GUID>"

    'VBAから利用できるメソッド
    Public Function SendMail(ByVal host As String, ByVal port As Integer, ByVal mailFrom As String,
                             ByVal mailTo As String, ByVal pass As String, ByVal subject As String,
                             ByVal body As String, Optional ByVal mailCC As String = "",
                             Optional ByVal mailBCC As String = "", Optional ByVal filePathsStr As String = "",
                             Optional ByVal isHTML As Boolean = False)

        Dim mailToSets() As String
        Dim mailFromSets() As String
        Dim mailCCs() As String
        Dim mailCCSets() As String
        Dim mailBCCs() As String
        Dim mailBCCSets() As String
        Dim filePathList() As String

        mailFromSets = splitMailAddress(mailFrom)
        mailToSets = splitMailAddress(mailTo)

        If mailFromSets(0) = "True" Or mailToSets(0) = "True" Then
            Exit Function
        End If

        Dim addressFrom As New MailAddress(mailFromSets(1), mailFromSets(2))
        Dim addressTo As New MailAddress(mailToSets(1), mailToSets(2))
        Dim message As New MailMessage(addressFrom, addressTo)

        'CCのアドレスを設定(任意)
        If mailCC = "" Then
        Else
            If InStr(mailCC, ",") <> 0 Then
                mailCCs = Split(mailCC, ",")
            Else
                ReDim mailCCs(0)
                mailCCs(0) = mailCC
            End If
           'アドレスの数だけループで設定
            For i As Integer = 0 To mailCCs.Length - 1
                mailCCSets = splitMailAddress(mailCCs(i))
                message.CC.Add(New MailAddress(mailCCSets(1), mailCCSets(2)))
            Next
        End If

        'BCCのアドレスを設定(任意)
        If mailBCC = "" Then
        Else
            If InStr(mailBCC, ",") <> 0 Then
                mailBCCs = Split(mailBCC, ",")
            Else
                ReDim mailBCCs(0)
                mailBCCs(0) = mailBCC
            End If
            For i As Integer = 0 To mailBCCs.Length - 1
                mailBCCSets = splitMailAddress(mailBCCs(i))
                message.Bcc.Add(New MailAddress(mailBCCSets(1), mailBCCSets(2)))
            Next
        End If

        message.Subject = subject
        message.Body = body

        '添付ファイルを設定(任意)
        If filePathsStr = "" Then
        Else
            If InStr(filePathsStr, ",") <> 0 Then
                filePathList = Split(filePathsStr, ",")
            Else
                ReDim filePathList(0)
                filePathList(0) = filePathsStr
            End If
            For i As Integer = 0 To filePathList.Length - 1
                Dim attach As New System.Net.Mail.Attachment(filePathList(i))
                message.Attachments.Add(attach)
            Next
        End If

        'HTMLメールかどうかを設定
        If isHTML Then
            message.IsBodyHtml = True
        End If

        Dim sc As New System.Net.Mail.SmtpClient()
        sc.Host = host
        sc.Port = port
        sc.DeliveryMethod = System.Net.Mail.SmtpDeliveryMethod.Network
        sc.Credentials = New System.Net.NetworkCredential(mailFromSets(1), pass)
        sc.EnableSsl = True

        'メールを送信
        Try
            sc.Send(message)
        Catch ex As System.Exception
            Return ex.ToString
            Throw
        End Try

        message.Dispose()
        sc.Dispose()
    End Function

    'メール文字列を表示名とメールアドレスに分けた配列を返す
    '例: Hoge<hoge@example.com> -> array(1)=>Hoge, array(2)=>hoge@example.com
    Function splitMailAddress(ByVal mailStr As String)
        Dim mailAddressStr As String
        Dim mailDisplayStr As String
        Dim mailAddressMatch As Match = Regex.Match(mailStr, "<(?<address>(.+@.+))>")
        Dim mailDisplayMatch As Match = Regex.Match(mailStr, "(?<display>(.+))<.+@.+>")
        Dim mailSets() As String
        ReDim mailSets(2)

        'メールアドレス抽出
        If mailAddressMatch.Length <> 0 Then
            mailAddressStr = mailAddressMatch.Groups("address").ToString()
        Else
            mailAddressStr = mailStr
        End If
        '表示名抽出
        If mailDisplayMatch.Length <> 0 Then
            mailDisplayStr = mailDisplayMatch.Groups("display").ToString()
        Else
            '表示名がなければメールアドレスを表示名にする
            mailDisplayStr = mailAddressStr
        End If

        mailSets(0) = "False"
        mailSets(1) = mailAddressStr
        mailSets(2) = mailDisplayStr
        splitMailAddress = mailSets
    End Function
End Class

後半に記述しているsplitMailAddress関数は、”Hoge“のように入力されたアドレス文字列の引数を、山かっこで表示名とアドレスを分けて配列として返す関数です。コード内で適時使用しています。CC、BCC、添付ファイルなどは、複数ある場合カンマ区切りの文字列の引数になりますが、その引数をSplit関数で配列に分け、ループで複数設定するようにしています。

sending_email_using_vba_by_dotnet_library_003

ビルドする前に、ソリューションエクスプローラーからプロジェクト名のところで右クリックメニューからプロパティを選択します。コンパイル項目を選択して、COM相互運用機能の登録にチェックを入れます。

ビルドを行うと、Visual Studioのプロジェクトフォルダにdllライブラリが出力されます。

Visual Studio 2015\Projects\SMTPClientClassLibraryForVBA\SMTPClientClassLibraryForVBA\obj\Debug\SMTPClientClassLibraryForVBA.dll
sending_email_using_vba_by_dotnet_library_004

Excelの参照設定のリストに追加されます。

Excelから送信する例は以下です。BCCなし、添付ファイル有りのHTMLメールを送信しています。

Sub sendMail()
    Dim objSMTP As Object
    Dim flag As Variant

    Set objSMTP = CreateObject("SmtpClientClassLibraryForVBA.SmtpClientVBA")
    flag = objSMTP.sendMail("smtp.example.com", "587", "from@example.com", "to@example.com", _
                            "password", "メールタイトル", "<h1>メール本文</h1>", _
                            "cc@example.com", "", "C:\Users\msfkz_000\Desktop\添付.txt", True)        
End Sub

他のパソコンで使うには、このライブラリファイルをコピーすればいいですが、コピー先のパソコンで以下のコマンドを実行する必要があります。

>regasm SMTPClientClassLibraryForVBA.dll /tlb:SMTPClientClassLibraryForVBA.tlb /codebase

regasmコマンドが認識されない場合は、.NETのフォルダーにあると思うのでパスを指定して呼び出します。

>C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe SMTPClientClassLibraryForVBA.dll /tlb:SMTPClientClassLibraryForVBA.tlb /codebase
Microsoft .NET Framework Assembly Registration Utility 4.6.1038.0
for Microsoft .NET Framework Version 4.6.1038.0
Copyright (C) Microsoft Corporation.  All rights reserved.


RegAsm : warning RA0000 : 署名されていないアセンブリを /codebase を使用して登録すると、同じコンピューターにインストール されるその他のアプリケーションとの競合が生じる可能性があります。/codebase スイッチは署名されたアセンブリのみに使用できます。アセンブリに厳密な名前を付けて、再登録してください。
型は正常に登録されました。
アセンブリは 'C:\Users\ユーザー名\Documents\Library\SMTPClientClassLibraryForVBA.tlb' にエクスポートされ、タイプ ライ ブラリは正常に登録されました。

作成したライブラリは、WindowsアプリやVBScript、Powershellなどからも使えると思います!(未検証)


Warning: include(social-footer.html): failed to open stream: No such file or directory in /home/phase1/lifedesignedit.com/public_html/contents/themes/ldestylesheet/post-formats/format.php on line 50

Warning: include(): Failed opening 'social-footer.html' for inclusion (include_path='.:/opt/php-5.6.30/data/pear') in /home/phase1/lifedesignedit.com/public_html/contents/themes/ldestylesheet/post-formats/format.php on line 50

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です