How to send mail with VBA using CDO // Mail Server is Exchange with proxy

问题

This is my actual code on VBA...

Private Message As CDO.Message
Private Attachment, Expression, Matches, FilenameMatch, i

Sub enviar_mail()

    Set Message = New CDO.Message
    Message.Subject = "my subject here"
    Message.From = "jhony.donosso@road-track.com"
    Message.To = "jhony.donosso@road-track.com"
    Message.TextBody = "my text body here"

    Dim Configuration
    Set Configuration = CreateObject("CDO.Configuration")
    Configuration.Load -1 ' CDO Source Defaults
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "my_mail_server" 'A
    'Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 26
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "my_user"
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "my_pass"
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxyserver") = "my_url_proxy" 'B
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxyport") = "443" 'https
    Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxybypass") = "my_urlproxybypass" 'C

    Configuration.Fields.Update

    Set Message.Configuration = Configuration
    Message.Send
End Sub

when I run the sub, i got this message: The transport failed to connect to the server.

this is my proxy configuration

回答1:

What your trying to do wont work because your looking at the MAPI/HTTP proxy setting and your trying to send the message via SMTP (these are two different protocols). So you need to use the actual SMTP setting for the Exchange server (eg it should be either port 25 or the client port 993) or you could look at using EWS instead if you know the EWS endpoint eg for Office365

Sub SendMessage(Subject As String, Recipient As String, Body As String, User As String, Password As String)
   Dim sReq As String
   Dim xmlMethod As String
   Dim XMLreq As New MSXML2.XMLHTTP60
   Dim EWSEndPoint As String
   EWSEndPoint = "https://outlook.office365.com/EWS/Exchange.asmx"
   sReq = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
   sReq = sReq & "<soap:Envelope xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:t=""http://schemas.microsoft.com/exchange/services/2006/types"">" & vbCrLf
   sReq = sReq & "<soap:Header>" & vbCrLf
   sReq = sReq & "<t:RequestServerVersion Version=""Exchange2010""/>" & vbCrLf
   sReq = sReq & "</soap:Header>" & vbCrLf
   sReq = sReq & "<soap:Body>" & vbCrLf
   sReq = sReq & "<CreateItem MessageDisposition=""SendAndSaveCopy"" xmlns=""http://schemas.microsoft.com/exchange/services/2006/messages"">" & vbCrLf
   sReq = sReq & "<SavedItemFolderId>" & vbCrLf
   sReq = sReq & "<t:DistinguishedFolderId Id=""sentitems"" />" & vbCrLf
   sReq = sReq & "</SavedItemFolderId>" & vbCrLf
   sReq = sReq & "<Items>" & vbCrLf
   sReq = sReq & "<t:Message>" & vbCrLf
   sReq = sReq & "<t:ItemClass>IPM.Note</t:ItemClass>" & vbCrLf
   sReq = sReq & "<t:Subject>" & Subject & "</t:Subject>" & vbCrLf
   sReq = sReq & "<t:Body BodyType=""Text"">" & Body & "</t:Body>" & vbCrLf
   sReq = sReq & "<t:ToRecipients>" & vbCrLf
   sReq = sReq & "  <t:Mailbox>" & vbCrLf
   sReq = sReq & "       <t:EmailAddress>" & Recipient & "</t:EmailAddress>" & vbCrLf
   sReq = sReq & "  </t:Mailbox>" & vbCrLf
   sReq = sReq & "</t:ToRecipients>" & vbCrLf
   sReq = sReq & "</t:Message>" & vbCrLf
   sReq = sReq & "</Items>" & vbCrLf
   sReq = sReq & "</CreateItem>" & vbCrLf
   sReq = sReq & "</soap:Body>" & vbCrLf
   sReq = sReq & "</soap:Envelope>" & vbCrLf
   xmlMethod = "POST"
   XMLreq.Open xmlMethod, EWSEndPoint, False, User, Password
   XMLreq.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
   XMLreq.setRequestHeader "Translate", "F"
   XMLreq.setRequestHeader "User-Agent", "Blah"
   XMLreq.send sReq
   If XMLreq.Status = 207 Then
   End If
End Sub

来源：https://stackoverflow.com/questions/38597467/how-to-send-mail-with-vba-using-cdo-mail-server-is-exchange-with-proxy

标签

vba

proxy

exchange-server