Sub dx()
Dim msg_txt As String, msg_sub As String, msg_to As String
msg_txt = "message text "
msg_sub = "message subject"
msg_to = "test@test.com"
CdoSend msg_to, "test@test.com", msg_sub, msg_txt
End Sub
'''''''''''''''''''''''''''''''''
Public Function CdoSend( _
MailTo As String, _
MailFrom As String, _
Subject As String, _
MessageText As String, _
Optional CC As String, _
Optional BCC As String, _
Optional FileAttachment As String) As Boolean
On Error GoTo CdoSend_Err
' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "dfwmail.te.test.com"
.Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = MailTo
.CC = CC
.BCC = BCC
.FROM = MailFrom
.Subject = Subject
.TextBody = MessageText
If Len(FileAttachment & "") > 0 Then
'## Last make sure the file actually exists and send it!:
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(FileAttachment) Then
.AddAttachment FileAttachment
Else
'otherwise return that the send failed and exit function:
Debug.Print "[CdoSend.Error]=> File attachment path does not exist, quitting..."
CdoSend = False
Exit Function
End If
End If
'## Send zee message! ##
.sEnd
End With
Set fso = Nothing
Set iMsg = Nothing
Set iConf = Nothing
CdoSend = True
CdoSend_Exit:
Exit Function
CdoSend_Err:
Debug.Print "[CdoSend.Error(" & Err.Number & ")]=> " & Err.Description
CdoSend = False
Resume CdoSend_Exit
End Function