Posted to microsoft.public.excel.programming
|
|
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
|