Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

CDOでHTMLメール送信

View gist:2007377
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
Option Explicit
 
Sub test()
Const cdoSendUsingPort = 2
Dim conf
Dim msg
Dim html_path
Dim html
Set conf = CreateObject("CDO.Configuration")
With conf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP SERVER"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "EMAIL"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PASSWORD"
.Update
End With
html_path = "body.html"
html = ReadAllTextFile(html_path)
Set msg = CreateObject("CDO.Message")
With msg
Set .Configuration = conf
.To = "EMAL"
.From = "EMAL"
.Subject = "SUBJECT"
.HTMLBody = html
.Send
End With
Set msg = Nothing
Set conf = Nothing
MsgBox "Mail Sent!"
End Sub
 
Function ReadAllTextFile(path)
Const ForReading = 1
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(path, ForReading)
ReadAllTextFile = f.ReadAll
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.