Send Email using CDO

[Markus]

Hallo

I hope some one can help me im using the folowing code to send emails trough
our company exhange server and its working fine but now they want me to send
it trough a relay server can any one tell me how do i set it up. The PC where
the app is running on is XP

Regards Markus

Option Compare Database
Option Explicit

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 cdoNotUsed = -1

Public Enum AuthTypes
cdoAnonymous = 0 'Do not authenticate
cdoBasic = 1 'Clear-text authentication
cdoNTLM = 2 'NT authentication
End Enum

Public Server As String 'Name or IP of Remote SMTP Server
Public UserId As String 'Logon name
Public Password As String 'Logon password
Public SendUsing As Long 'default: cdoSendUsingPort
Public Authenticate As AuthTypes 'default: cdoNotUsed
Public ServerPort As Long 'default: cdoNotUsed
Public UseSSL As Long 'default: cdoNotUsed
Public Timeout As Long 'default: cdoNotUsed
'
Public Sender As String 'eg (e-mail address removed)
Public SenderName As String 'eg Bill Gates
Public Receiver As String 'eg (e-mail address removed)
Public ReceiverName As String 'eg Stuart McCall
Public CC As String 'Carbon Copy
Public BCC As String 'Blind Carbon Copy
Public Subject As String 'Message subject text
Public Text As String 'Message body text
Public HTML As Boolean 'Indicates message body text is HTML
Public Files As New Collection 'File paths of files to attach

Public Sub SendMail()
Const qt = """"
Const Prefix = "http://schemas.microsoft.com/cdo/configuration/"
Dim msg As Object
Dim f As Variant

Set msg = CreateObject("CDO.Message")
With msg
If Not IsVoid(SenderName) Then
.From = qt & SenderName & qt & " <" & Sender & ">"
Else
.From = Sender
End If
If Not IsVoid(ReceiverName) Then
.to = qt & ReceiverName & qt & " <" & Receiver & ">"
Else
.to = Receiver
End If
.CC = CC
.BCC = BCC
.Subject = Subject
If HTML Then .HTMLBody = Text Else .TextBody = Text
For Each f In Files
.AddAttachment f
Next
With .Configuration.Fields
.Item(Prefix & "sendusing") = SendUsing
If Not IsVoid(Server) Then .Item(Prefix & "smtpserver") = Server
If Not IsVoid(UserId) Then .Item(Prefix & "sendusername") = UserId
If Not IsVoid(Password) Then .Item(Prefix & "sendpassword") =
Password
If Authenticate > cdoNotUsed Then .Item(Prefix &
"smtpauthenticate") = Authenticate
If ServerPort > cdoNotUsed Then .Item(Prefix & "smtpserverport")
= ServerPort
'If UseSSL > cdoNotUsed Then .Item(Prefix & "smtpusessl") = UseSSL
If Timeout > cdoNotUsed Then .Item(Prefix &
"smtpconnectiontimeout") = Timeout
.Update
End With
.Send
End With

Set msg = Nothing
End Sub

Private Sub Class_Initialize()
SendUsing = 2
Authenticate = 1
ServerPort = 25
UseSSL = False
Timeout = 60
End Sub

Private Function IsVoid(v) As Boolean
IsVoid = (Len(v & "") = 0)
End Function

 

[Stuart McCall]

Hallo

I hope some one can help me im using the folowing code to send emails
trough
our company exhange server and its working fine but now they want me to
send
it trough a relay server can any one tell me how do i set it up. The PC
where
the app is running on is XP

Regards Markus

Option Compare Database
Option Explicit

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 cdoNotUsed = -1

Public Enum AuthTypes
cdoAnonymous = 0 'Do not authenticate
cdoBasic = 1 'Clear-text authentication
cdoNTLM = 2 'NT authentication
End Enum

Public Server As String 'Name or IP of Remote SMTP Server
Public UserId As String 'Logon name
Public Password As String 'Logon password
Public SendUsing As Long 'default: cdoSendUsingPort
Public Authenticate As AuthTypes 'default: cdoNotUsed
Public ServerPort As Long 'default: cdoNotUsed
Public UseSSL As Long 'default: cdoNotUsed
Public Timeout As Long 'default: cdoNotUsed
'
Public Sender As String 'eg (e-mail address removed)
Public SenderName As String 'eg Bill Gates
Public Receiver As String 'eg (e-mail address removed)
Public ReceiverName As String 'eg Stuart McCall
Public CC As String 'Carbon Copy
Public BCC As String 'Blind Carbon Copy
Public Subject As String 'Message subject text
Public Text As String 'Message body text
Public HTML As Boolean 'Indicates message body text is
HTML
Public Files As New Collection 'File paths of files to attach

Public Sub SendMail()
Const qt = """"
Const Prefix = "http://schemas.microsoft.com/cdo/configuration/"
Dim msg As Object
Dim f As Variant

Set msg = CreateObject("CDO.Message")
With msg
If Not IsVoid(SenderName) Then
.From = qt & SenderName & qt & " <" & Sender & ">"
Else
.From = Sender
End If
If Not IsVoid(ReceiverName) Then
.to = qt & ReceiverName & qt & " <" & Receiver & ">"
Else
.to = Receiver
End If
.CC = CC
.BCC = BCC
.Subject = Subject
If HTML Then .HTMLBody = Text Else .TextBody = Text
For Each f In Files
.AddAttachment f
Next
With .Configuration.Fields
.Item(Prefix & "sendusing") = SendUsing
If Not IsVoid(Server) Then .Item(Prefix & "smtpserver") =
Server
If Not IsVoid(UserId) Then .Item(Prefix & "sendusername") =
UserId
If Not IsVoid(Password) Then .Item(Prefix & "sendpassword") =
Password
If Authenticate > cdoNotUsed Then .Item(Prefix &
"smtpauthenticate") = Authenticate
If ServerPort > cdoNotUsed Then .Item(Prefix &
"smtpserverport")
= ServerPort
'If UseSSL > cdoNotUsed Then .Item(Prefix & "smtpusessl") =
UseSSL
If Timeout > cdoNotUsed Then .Item(Prefix &
"smtpconnectiontimeout") = Timeout
.Update
End With
.Send
End With

Set msg = Nothing
End Sub

Private Sub Class_Initialize()
SendUsing = 2
Authenticate = 1
ServerPort = 25
UseSSL = False
Timeout = 60
End Sub

Private Function IsVoid(v) As Boolean
IsVoid = (Len(v & "") = 0)
End Function

I've never dealt with a relay server, so I'm guessing here. It should (IMO)
be just a case of changing the Server, UserId and Password properties to
reflect the relay server's login details.

If that doesn't do it, you'll need to get in touch with the server's owner
for the necessary info.

Post back here with your findings and I'll either make any needed changes to
the class or I'll research the issue.

 

[Markus]

Thank you i already tryd just changing the server to details of the to use
the relay server but there i get a error that the relay server is not an
exhange server so it does not work. The answer from our IT poeple was when i
asked what i need to change in my program was that i need to change my
application server relay to be pointing the AAA.com and check the mail
functionality and that was it. And i have to be honest i have no idea what he
was talking about. I really hope some one can help me

Markus