R
RayportingMonkey
I am trying to use Ron DeBruin's CDO Email routine
http://www.rondebruin.nl/cdo.htm
But, I am running into some problems.
The exact code being used is as follows:
Sub CDO_Send_Selection_Or_Range_Body()
Dim rng As Range
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"MyExchangeServerHERE"
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
"MyIDHERE"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
"MyPasswordHERE"
.Update
End With
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With iMsg
Set .Configuration = iConf
.To = "(e-mail address removed)"
.CC = "(e-mail address removed)"
.BCC = ""
.From = """TestyTester"" <[email protected]>"
.Subject = "This is a test"
.HTMLBody = RangetoHTML(rng)
.Send
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
I'm not sure if I even have control over my potential issue - so any insight
would be appreciated as my IT Department is ignoring me...
When I run this routine with my Exchange Server and work credentials
specified, I get an error:
Run-time error '-2147220973(80040213)':
The transport failed to connect to the server,
If I substitute my home/isp information, the message seems to get sent to my
home account (I say seems to because we are quite locked down... I can't get
to my external email account, but I can see that a new message has been
received and that it has the subject I specified in my test), but it does NOT
arrive in my work email box...
Is there any limitation in CDO with sending to a domain outside of the one
the SMTP server is on? Or, am I just looking at an internal security lockdown?
Also, because I am simply trying to automate emailing of reports to other
users on the same domain and need to get around Outlook's security dialogue
box, is there a different approach I should be taking?
I really appreciate the help!
Thanks,
Ray
http://www.rondebruin.nl/cdo.htm
But, I am running into some problems.
The exact code being used is as follows:
Sub CDO_Send_Selection_Or_Range_Body()
Dim rng As Range
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"MyExchangeServerHERE"
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
"MyIDHERE"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
"MyPasswordHERE"
.Update
End With
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With iMsg
Set .Configuration = iConf
.To = "(e-mail address removed)"
.CC = "(e-mail address removed)"
.BCC = ""
.From = """TestyTester"" <[email protected]>"
.Subject = "This is a test"
.HTMLBody = RangetoHTML(rng)
.Send
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
I'm not sure if I even have control over my potential issue - so any insight
would be appreciated as my IT Department is ignoring me...
When I run this routine with my Exchange Server and work credentials
specified, I get an error:
Run-time error '-2147220973(80040213)':
The transport failed to connect to the server,
If I substitute my home/isp information, the message seems to get sent to my
home account (I say seems to because we are quite locked down... I can't get
to my external email account, but I can see that a new message has been
received and that it has the subject I specified in my test), but it does NOT
arrive in my work email box...
Is there any limitation in CDO with sending to a domain outside of the one
the SMTP server is on? Or, am I just looking at an internal security lockdown?
Also, because I am simply trying to automate emailing of reports to other
users on the same domain and need to get around Outlook's security dialogue
box, is there a different approach I should be taking?
I really appreciate the help!
Thanks,
Ray