0

我有以下代码在本地网络中运行良好。但我希望相同的功能适用于通过 vpn 连接的远程机器，即使我没有登录也是如此。

Function Sendmail()
    Dim objMessage
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Checking for latest file"
    objMessage.From = "d@tkd.com"
    objMessage.To = "s@tkd.com"
    objMessage.TextBody = "This is to intimate you regrding latest File........."

    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2  

    'Name or IP of Remote SMTP Server
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.tkd.com"

    'Type of authentication, NONE, Basic (Base64 encoded), NTLM
    objMessage.Configuration.Fields.Item _
    ( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ) = cdoBasic

    'Your UserID on the SMTP server
    objMessage.Configuration.Fields.Item _
    ( "http://schemas.microsoft.com/cdo/configuration/sendusername" ) = "deepika@tecknodreams.com"

    'Your password on the SMTP server
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "123"

    'Server Port
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

    'Use SSL for the connection (False or True)
    objMessage.Configuration.Fields.Item _
    ( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ) = False

    'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
    objMessage.Configuration.Fields.Item _
    ( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ) = 60


    objMessage.Configuration.Fields.Update
    objMessage.Send
End Function
4

1 回答 1

0

下面的示例代码是否适合您将完全取决于您的 SMTP 服务器的配置。如果您的服务器需要凭据才能传输电子邮件，那么此代码很可能会失败。如果您的服务器允许匿名邮件提交，它应该可以正常工作。

'
' Sends an email via SMTP using CDO
'
' When calling, supply:
'   fromAddress (e.g., "me@my.org")
'   toAddress   (e.g., "you@your.org")
'   subjectLine (e.g., "Here's what this message is about")
'   messageBody (e.g., "Here is a detailed message with lots of info...")
'   smtpServer  (e.g., "mail-server.my.org")
'
Sub sendEmail(fromAddress, toAddress, subjectLine, messageBody, smtpServer)

   Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
   Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).

   Const cdoAnonymous = 0 'Do not authenticate
   Const cdoBasic = 1 'basic (clear-text) authentication
   Const cdoNTLM = 2 'NTLM


   Set objMessage = CreateObject("CDO.Message")
   objMessage.Subject = subjectLine
   objMessage.From = fromAddress
   objMessage.To = toAddress
   objMessage.TextBody = messageBody
   'objMessage.AddAttachment "C:\files\filename.pdf"

   objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

   'Name or IP of Remote SMTP Server
   objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpServer

   'Type of authentication, NONE, Basic (Base64 encoded), NTLM
   objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous

   'Server port (typically 25)
   objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

   'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
   objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30

   objMessage.Configuration.Fields.Update

   '==End remote SMTP server configuration section==

   objMessage.Send


End Sub
于 2012-08-09T16:18:44.947 回答