VBAでメールを送信しないといけなかったので、.NETのSmtpClientライブラリを使って、自分で外部ライブラリを作成してみました。
主に参考にしたページはこちらになります。
VBAで独自の.NETライブラリを使うには？［VB］ － ＠ITこの例では言語はVBを使っていますので、C#などを使う場合は読み替えてください。
まずVisual Studioを起動し、ファイル>新規作成>プロジェクトを選択します。上の画面のようにテンプレートからVisual Basic>Windows>クラスライブラリを選択します。
メニューのツール>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
ビルドする前に、ソリューションエクスプローラーからプロジェクト名のところで右クリックメニューからプロパティを選択します。コンパイル項目を選択して、COM相互運用機能の登録にチェックを入れます。
ビルドを行うと、Visual Studioのプロジェクトフォルダにdllライブラリが出力されます。
Visual Studio 2015\Projects\SMTPClientClassLibraryForVBA\SMTPClientClassLibraryForVBA\obj\Debug\SMTPClientClassLibraryForVBA.dll
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 /codebaseregasmコマンドが認識されない場合は、.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などからも使えると思います！(未検証)
