sharing: How To Send Mail Using CDO Visual Basic

Apply To :
* Microsoft Visual Basic 6
* Windows Live Mail

Problem :
* Want to sending mail using code Visual Basic 6

Solution :

1. First, Go to menu "Project > References ... ".
Add for "Microsoft CDO for Windows 2000 Library"

2. Check for Windows Live Mail Settings,

3. Design an Example Form below

4. Copy the below code to "Form1.frm"

'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
'----CODE START

Private Sub Command1_Click()

Dim EmailAttachments_1(2) As String
EmailAttachments_1(0) = "E:\AttachFile_Test-01.txt"
EmailAttachments_1(1) = "E:\AttachFile_Test-02.txt"
EmailAttachments_1(2) = "E:\AttachFile_Test-03.txt"
Call SendMail("nameFrom@domain.co.id", _
"nameTo@domain.co.id", "nameCC@domain.co.id", "nameBCC@domain.co.id", _
"Subject - Test", "Content - Test", _
"mail.domain.co.id", "25", _
"name", "password", _
EmailAttachments_1(), _
0)

MsgBox "Sending Mail successfully..."

End Sub

Public Function SendMail _
(sFrom As String, _
sTo As String, sCC As String, sBCC As String, _
sSubject As String, sBody As String, _
sSmtpServer As String, iSmtpPort As Integer, _
sSmtpUser As String, sSmtpPword As String, _
EmailAttachments() As String, _
bSmtpSSL As Boolean) As String

On Error GoTo SendMail_Error:
Dim lobj_cdomsg As CDO.Message
Dim i As Integer
Set lobj_cdomsg = New CDO.Message
lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = sSmtpServer
lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = iSmtpPort
lobj_cdomsg.Configuration.Fields(cdoSMTPUseSSL) = bSmtpSSL
lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
lobj_cdomsg.Configuration.Fields(cdoSendUserName) = sSmtpUser
lobj_cdomsg.Configuration.Fields(cdoSendPassword) = sSmtpPword
lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 30
lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
lobj_cdomsg.Configuration.Fields.Update
lobj_cdomsg.To = sTo
lobj_cdomsg.CC = sCC
lobj_cdomsg.BCC = sBCC
lobj_cdomsg.From = sFrom
lobj_cdomsg.Subject = sSubject
lobj_cdomsg.TextBody = sBody

'---For add attachments if any
For i = LBound(EmailAttachments) To UBound(EmailAttachments)
If FileExists(EmailAttachments(i)) Then
lobj_cdomsg.AddAttachment (EmailAttachments(i))
End If
Next i

lobj_cdomsg.Send

Set lobj_cdomsg = Nothing
SendMail = "ok"

Exit Function

SendMail_Error:
SendMail = Err.Description

End Function

Function FileExists%(filename$)

Dim f%

'---Trap any errors that may occur
On Error Resume Next

'---Get a free file handle
f% = FreeFile
Open filename$ For Input As #f%
Close #f%
FileExists% = Not (Err <> 0)

End Function

'----CODE END
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------

A.