Lori,
I just ran this code a few minutes ago and it worked like a charm.
If you want, I can send you my smtp server name so that you can test this code from your PC against my SMTP server on the web. You will need to change the values for the sReplyToAddress, sFromAddress,sAttachment, and sSMTPServer variables. This will confirm whether or not it is a firewall or SMTP configuration issue or not. I suspect it is, since my code is not much different than yours.
regards,
Rosalind
Sub RemoteSMTPSend()
'~’ Function Name: RemoteSMTPSend()
’ Purpose: Send Email with attachment via remote SMTP Server
’ Returns: N/A
’ Author: Rosalind Beasley
’ Created: 11/28/2001
’ Update History:
'
'Late Binding to CDO 2000 Library
'Send the message using the network (SMTP over the network).
Const cdoSendUsingPort = 2
'2= send using network, 1= send using local smtp server
’ The following are the configuration enum values
Const cdoSendUsingMethod = “http://schemas.microsoft.com/cdo/configuration/sendusing”
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 cdoSMTPAccountName = “http://schemas.microsoft.com/cdo/configuration/SMTPAccountName”
Const cdoSendUserReplyEmailAddress = “http://schemas.microsoft.com/cdo/configuration/SendUserReplyEmailAddress”
Dim i As Integer
Dim sHtmlBody As String
Dim iConf As Object
Dim iMsg As Object
Dim flds As ADODB.Fields
Dim sReplyToAddress As String ’ Reply to address used in Mail Message
Dim sFromAddress As String ’ From Address used in Mail Message
Dim sToAddress As String ’ To Address used in Mail Message
Dim sSubject As String ’ Subject of the Mail Message
Dim sAttachment As String ’ Path and File Name of Attachment file
Dim sSmtpServer As String ’ SMTP Server Host Name
Dim iPortNumber As Integer ’ Port Number used by SMTP Server
Dim iTimeOut As Integer ’ Timeout for SMTP server transport
Dim bAppInteractive As Boolean ’ Aplication.Interactive value
Dim bAppBreakOnVbaError As Boolean ’ Application.BreakONVBAError value
Dim serrorlog As String ’ Name of Process Error Log File
Dim semaillog As String ’ Name of Email Process Log
On Error GoTo Error_Handler
sAccountName = “BCA”
sReplyToAddress = “user@server.com”
sFromAddress = “user@server.com”
sToAddress = “user@server.com”
sSubject = “CDO for Windows 2000”
sAttachment = “c:\Attachment.txt”
'— Email Server Settings —
sSmtpServer = “mail.server.com”
iPortNumber = 25
iTimeOut = 30
'— VBA Debug Settings —
bAppInteractive = False
bBreakOnVBAError = False
'— File Location Settings —
serrorlog = “c:\log\smtperror.log”
semaillog = “c:\log\smtpemail.log”
'Make sure the application does not enter any interactive mode
'Application.BreakOnVBAError = bAppBreakOnVbaError
'Application.Interactive = bAppInteractive
'Late binding to the CDO Library
Set iConf = CreateObject(“CDO.Configuration”)
Set iMsg = CreateObject(“CDO.Message”)
sHtmlBody = " "
sHtmlBody = sHtmlBody & " "
sHtmlBody = sHtmlBody & " "
sHtmlBody = sHtmlBody & " "
sHtmlBody = sHtmlBody & " "
sHtmlBody = sHtmlBody & " "
sHtmlBody = sHtmlBody & "
| This is the body of the message |
"
sHtmlBody = sHtmlBody & " "
sHtmlBody = sHtmlBody & " "
Set flds = iConf.Fields
'set the configuration for Network Send
With flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = sSmtpServer
.Item(cdoSMTPServerPort) = iPortNumber
.Item(cdoSMTPConnectionTimeout) = iTimeOut
.Item(cdoSMTPAccountName) = sAccountName
.Item(cdoSendUserReplyEmailAddress) = sReplyToAddress
.Update
End With
'Send email
Set iMsg = CreateObject("CDO.Message")
With iMsg
.Configuration = iConf
.from = sFromAddress
.To = sToAddress
.Subject = sSubject
.HTMLBody = sHtmlBody
.AddAttachment sAttachment
.ReplyTo = sReplyToAddress
.Send
End With
Set iMsg = Nothing
GoTo CleanUp
Error_Handler:
'write errors to logfile DFR.log
Open serrorlog For Append As #1
Print #1, Err.Number; Err.Description, Date, Time
Close #1
CleanUp:
'cleanup
Set flds = Nothing
Set iMsg = Nothing
Set iConf = Nothing
Exit Sub
End Sub
Rosalind Beasley (BOB member since 2002-09-11)
(BOB member since 2002-09-24)
(BOB member since 2002-09-24)
Hope so… I’ve never tried this, but that jumped out at me this morning.
(BOB member since 2002-08-16)