VB：如何用需要身份验证的SMTP邮件服务器发信？

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