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 に答える