View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Patrick Molloy Patrick Molloy is offline
external usenet poster
 
Posts: 1,049
Default Email Using CDO - mixed results

can you connect the laptop directly too - just to check that the code still
works?

"Steve" wrote in message
...
Hi Ron,

I had a chance to check out the program over another wireless network and
got the exact same message. Do you have any other ideas?

Thanks,

Steve

"Ron de Bruin" wrote:

Hi Steve

Maybe a wireless router setting block it
Try it in another wireless network and see if it is working there

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"Steve" wrote in message
...
I have successfully used the CDO code provided by Ron deBruin site. It
works
great from my desktop computer directly connect to the web. However,
when I
move it to my laptop, which uses my wireless router to access the web,
it
fails on the ".send" with Run-time failure "-2147220973 (80040213)':
The
transport failed to connect to the server.

Does anyone have a solution for this problem. I'd appreciate it! Code
follows:

Sub MailWorkbook(emailaddr, mbrpth, emailcontact)
'This procedure will mail the whole workbook
'You can't send a Workbook that is open with CDO.
'That's why it use SaveCopyAs to save it with another name and send
that file.
'Working in 2000-2007
Dim wb As Workbook
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant

Set wb = ActiveWorkbook

If Val(Application.Version) = 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be
no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

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/smtpusessl") =
True

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
"

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
"africa99"

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"smtp.gmail.com"

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With

With iMsg
Set .Configuration = iConf
.To = emailaddr
.cc = ""
.BCC = ""
.From = """Peggy Newell"" "
.Subject = Range("EmailSubj")
If emailcontact = "" Then
.textbody = Range("EmailMsg") & Range("EmailClose")
Else
.textbody = Replace(Range("EmailMsg"), "Member,",
emailcontact &
",") & Range("EmailClose")
End If
If mbrpth < "Skip" Then .AddAttachment mbrpth
.Send
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub