| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email Using CDO - mixed results
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Email Using CDO - mixed results
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Email Using CDO - mixed results
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Email Using CDO - mixed results
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 "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 |
|
#5
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 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Email Using CDO - mixed results
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 "Patrick Molloy" wrote: 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 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Email Using CDO - mixed results
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" 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| How to sort and export just email addresses in a mixed column | Excel Worksheet Functions | |||
| Mixed format | Excel Programming | |||
| mixed text and formula results | Excel Worksheet Functions | |||
| mixed text and formula results | Excel Discussion (Misc queries) | |||
| Mixed 3D Charts | Charts and Charting in Excel | |||
Hybrid Mode
