様々なプログラムでは簡単にメールを送る仕組みがあります。
それはSendMailと呼ばれます。
VBAでも、そのようなものがあると便利かと思いましたので、作ってみました。
これで、ボタン一つで売上データを集計したものから請求書をPDFファイルで作成しそれを送付してもよし、毎日の月報を行動履歴から作成してパソコンの電源を切る前にメール送付するVBAを起動してもよし、様々な応用が利くと思います。
書式は
それはSendMailと呼ばれます。
VBAでも、そのようなものがあると便利かと思いましたので、作ってみました。
これで、ボタン一つで売上データを集計したものから請求書をPDFファイルで作成しそれを送付してもよし、毎日の月報を行動履歴から作成してパソコンの電源を切る前にメール送付するVBAを起動してもよし、様々な応用が利くと思います。
書式は
Do_SendMail(送信先アドレス, 送信元アドレス, タイトル, 本文, 添付ファイルパス名)
で指定します。
Do_SendMail(Range("B1").Value, "xxx@yosato.net", "請求書", "請求書をお送りします。サトウ","D:\請求書\" & Range("C1").Value)これでセルB1に入力されているメールアドレスに、セルC1に入っているファイル名のファイルを添付し、メールを送信できます。
プロバイダやWebサーバーのメールの設定が必要ですので、契約しているプロバイダ、お使いのサーバーのサイトからメールサーバー情報を調べてください。
Function Do_SendMail(Dest As String, Dist As String, Title As String, Text As String, Attachment As String)'// Do_SendMail(送信先アドレス, 送信元アドレス, タイトル, 本文, 添付ファイルパス名)
'// ex) Call Do_SendMail("vbatest@yosato.net", "vbatest@yosato.net", "title", "honbun", "C:\請求書.pdf")Dim m_obj As VariantDim SMTPServer As String
Dim SMTPPort As Integer
Dim SSL As Boolean
Dim SMTPOuth As Integer
Dim UserName As String
Dim PASSWD As String
Dim TimeOut As Integer'//メールサーバー設定
SMTPServer = "yosato.net" '// SMTPサーバー：ex)yosato.net
SMTPPort = 587 '// 送信ポート：ex)587
SSL = False '// SSLを使うか：ex)false
SMTPOuth = 1 '// SMTP認証するか：ex)1
UserName = "vbatest@yosato.net" 'サーバー認証アカウント名// ex)vbatest@yosato.net
PASSWD = "vba123123" '// パスワード
TimeOut = 60 'サーバータイムアウト
'//Set m_obj = CreateObject("CDO.Message")
m_obj.From = Dist
m_obj.To = Dest
m_obj.Subject = Title
m_obj.TextBody = Text
If Attachment <> "" Then
m_obj.AddAttachment Attachment
End If
With m_obj.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = SMTPOuth
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = UserName
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PASSWD
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = TimeOut
.Update
End With
m_obj.Send
Set m_obj = Nothing
End Function
コメント