Option Explicit
'需要引用  Microsoft CDO for Windows 2000 Library和 Microsoft ActiveX Data Objects 2.5 Library

Private Sub Command1_Click()
Const cdoSendUsingMethod = _
    "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSendUsingPort = 2
Const cdoSMTPServer = _
    "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = _
    "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = _
    "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPAuthenticate = _
    "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoBasic = 1
Const cdoSendUserName = _
    "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendPassword = _
    "http://schemas.microsoft.com/cdo/configuration/sendpassword"

Dim objConfig   As CDO.Configuration
Dim objMessage  As CDO.Message
Dim Fields      As ADODB.Fields

' Get a handle on the config object and it's fields
Set objConfig = New CDO.Configuration
Set Fields = objConfig.Fields

' Set config fields we care about
With Fields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServer) = "smtp邮件服务器"
    .Item(cdoSMTPServerPort) = 25 '端口，默认为25
    .Item(cdoSMTPConnectionTimeout) = 10
    .Item(cdoSMTPAuthenticate) = cdoBasic
    .Item(cdoSendUserName) = "用户名"
    .Item(cdoSendPassword) = "密码"

    .Update
End With

Set objMessage = New CDO.Message '

Set objMessage.Configuration = objConfig

With objMessage
    .To = "收件人地址"
    .From = "Display Name <email_address>"
    .Subject = "SMTP Relay Test"
    .TextBody = "SMTP Relay Test Sent @ " & Now()
    .Send
End With

Set Fields = Nothing
Set objMessage = Nothing
Set objConfig = Nothing

End Sub