VBAでメール送信

■　メール送信（CDO)

Private Sub sendMail(ByVal FULLPATH_ATTACHMENT As String)

Dim strFrom, strReply, strServer, nPort, strUser, strPass, strTo, strCc, strBcc, strSubject, strTextbody, strAddAttachment

Dim Cdo

'****************************************************************

'メール送信元の設定

'****************************************************************

strFrom = "VBAメール <sender_address@company.com>"

strReply = ""

strServer = "smtp.server_name.company.com"

nPort = 25

strUser = ""

strPass = ""

'****************************************************************

'メール送信先の設定＆メール本体の作成

'****************************************************************

strTo = "receiver_address@company.com"

strCc = ""

strBcc = ""

strSubject = "VBAメール"

strTextbody = ""

strAddAttachment = FULLPATH_ATTACHMENT

'****************************************************************

' メール送信

'****************************************************************

Set Cdo = CreateObject("CDO.Message")

Cdo.FROM = strFrom

Cdo.ReplyTo = strReply

Cdo.To = strTo

Cdo.cc = strCc

Cdo.Bcc = strBcc

Cdo.Subject = strSubject

Cdo.Textbody = strTextbody

Cdo.AddAttachment strAddAttachment

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = nPort

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = False

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser

Cdo.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass

Cdo.Configuration.Fields.Update

On Error Resume Next

Cdo.Send

On Error GoTo 0

'****************************************************************

' 終了

'****************************************************************

End Sub