Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
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 |