Email Using CDO - mixed results

[Steve]

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") =
"(e-mail address removed)"

..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"" <[email protected]>"
.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

 

[Ron de Bruin]

Hi Steve

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

 

[Steve]

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]

Hi Steve

I check it out in my own network today when I am home from work

--

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

 

[Patrick Molloy]

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

 

[Ron de Bruin]

Hi Steve

I just test it on my laptop with the last build of Win 7 and Office 2007 sp1 and no
problems to mail with the code from my site.
http://www.rondebruin.nl/cdo.htm

Check out your firewall settings on the laptop


--

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

 

[Steve]

Hi Patrick,

I have a desktop that I use for testing and it always works from there. I
have tried from my son-in-laws wireless network, and I'll be darned if it
didn't work. I did happen to have Windows Firewall turned off, but since
then I've turned it on and it still seems to be working. At this point I'd
say that it is sporadic. I'm still trying to nail down the specific problem
so others can benefit from the testing as well.

Thanks,

Steve