Herllo
我一直在尝试使用一些CDO消息VBA编码来自动发送短电子邮件。所有这些都是私人使用的，每天最多只发送几封电子邮件。电子邮件要么是为我的家人，要么是与我共享代码的其他人，例如在免费帮助论坛上。我的宏绝对有效，而且在过去非常可靠。最近，我发现越来越多的电子邮件帐户不再有效。因此，我不得不用另一个帐户替换发送电子邮件的帐户。我的账户快用完了。新帐户要么不起作用，要么只起了几次作用，然后在进一步尝试时会出现各种错误。我使用的同一提供商的不同帐户都有相同的设置，在某些情况下，以前也以类似的方式使用过。但一些账户仍然在CDO信息发送中工作，其他账户则没有。哪些有效，哪些无效，这似乎是随机的，而且越来越不起作用。
除了不能解决我的问题的自动问答或浪费时间的电话帮助线之外，我无法从电子邮件提供商那里找到任何帮助
有人能推荐一个电子邮件帐户提供商吗？他们发现该提供商的帐户在CDO消息宏中一致工作。
我想我知道大多数必需的设置，因为我之前已经能够让帐户正常工作。我猜测，也许垃圾邮件软件正在收紧，作为一种副产品，真正的使用更容易被错误地阻止……我猜测，账户的自动使用更容易引起怀疑。
gmail对我来说一直很可靠。但现在10个账户中有7个不起作用。我不能再注册了，因为他们限制你每个确认电话号码只能注册几次。所以我预计很快gmail将不再是我的选择。
雅虎和yandex上的新账户通常会工作几次，然后停止工作。偶尔他们会再次工作。
我目前唯一一直在工作的供应商是一家德国小型电信供应商。但根据Sod定律，我需要的一些电子邮件功能在大多数其他提供商上都可用。。但不是在这个德国！！：--(
我可以在不同的地点使用几台不同的电脑和互联网连接。我在不同的地方得到了相似的结果。所以我不认为这是间歇性的问题与我的互联网连接有关。我的意思是，一个目前一直在工作的账户将在不同地方使用不同质量的互联网连接。
我的猜测是，问题来自自动安全措施，这对不同的提供商来说会有所不同，所以这就是为什么我要求其他人体验电子邮件帐户和CDO消息发送编码。
在所有情况下，停止CDO编码的帐户仍然可以手动工作。我知道，当从新位置使用帐户时，经常会出现临时阻塞。这只会导致临时阻塞。这不是我的问题。这些临时阻塞也发生在工作帐户上，我知道如何处理它们。
ThxAlan
为我的最后一个答案编码(Excel VBA CDO消息电子邮件发送帐户的工作越来越少…(
编辑：答案贴被隐藏了！-这是它的副本：http://www.excelfox.com/forum/showthread.php/2380-Tests-and-Notes-for-EMail-Threads?p=11548&viewfull=1#post11548
Option Explicit
''_-(ii) "sendusername" , "sendpassword" , "smtpusessl" , "smtpauthenticate" , "smtpserver" , "sendusing" , "smtpserverport" , "smtpconnectiontimeout"
'Sub ScrudOverFlowDemolition(ByVal UsrNme As String, ByVal PssWrd As String, ByVal SlutPussly As String, ByVal PatheticCake As String, ByVal ServiceChef As String, ByVal WayntkerUsed As String, ByVal ConnectingDoor As String, ByVal WaitSecs As String, ByVal Snd_Frm As String)
Dim CunFik() As String ' CDO Account configuration
Dim CunFikaNation As String ' CDO Account configurations, CunFik(x)s seperated by vbCr & vbLf is "sendusername" "sendpassword" "smtpusessl" "smtpauthenticate" "smtpserver" "sendusing" "smtpserverport" "smtpconnectiontimeout"
'_- Program_(i)
' ( '_-(ii) ScrudOverFlow..("sendusername","sendpassword","smtpusessl","smtpauthenticate","smtpserver","sendusing","smtpserverport","smtpconnectiontimeout", .From )
Sub TestCall_ScrudOverFlowDemolition()
Let CunFikaNation = ""
Rem 1 Collect of accounts and their configuration parameters
' gmail
Call ScrudOverFlowDemolition("1234567890123456789.com", "xxxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "ExcelVBAExp@gmail.com")
Call ScrudOverFlowDemolition("1234567890@gmail.com", "xxxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "mail2taste@gmail.com")
Call ScrudOverFlowDemolition("1234567890@gmail.com", "xxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "25", "30", "mail2taste@gmail.com")
Call ScrudOverFlowDemolition("1234567890123456@gmail.com", "xxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "excellearning12@gmail.com")
Call ScrudOverFlowDemolition("12345678901@gmail.com", "xxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "JaneAmbrose1958@gmail.com")
Call ScrudOverFlowDemolition("1234567890@gmail.com", "xxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "CDOMsgExp@gmail.com")
Call ScrudOverFlowDemolition("123456789@gmail.com", "xxxxxxx", "True", "1", "smtp.gmail.com", "2", "25", "30", "CDOMsgExp@gmail.com")
' Yandex
Call ScrudOverFlowDemolition("xxxxxxxxxxx@yandex.com", "xxxxxxxxx", "True", "1", "smtp.yandex.com", "2", "465", "30", "developmentstest@yandex.com")
Call ScrudOverFlowDemolition("eeeeeeeeeee@yandex.com", "ahetkdkjhddhj", "True", "1", "smtp.yandex.com", "2", "465", "30", "developmentstest@yandex.com")
Call ScrudOverFlowDemolition("123456789@yandex.com", "96lskKFHSHFDLHF", "True", "1", "smtp.yandex.com", "2", "465", "30", "123456789@yandex.com")
' Yahoo
Call ScrudOverFlowDemolition("1234567890@yahoo.com", "XXXXXXXX", "True", "1", "smtp.mail.yahoo.com", "2", "465", "30", "yangsfool@yahoo.com")
' Outlook
Call ScrudOverFlowDemolition("12345678901@Outlook.com", "cccccccccc*", "True", "1", "smtp-mail.outlook.com", "2", "587", "30", "MollyBrennholz@Outlook.com")
Call ScrudOverFlowDemolition("123456789012@Outlook.com", "yyyyyyyy", "True", "1", "smtp-mail.outlook.com", "2", "587", "30", "excellearning@Outlook.com")
'Call ScrudOverFlowDemolition("123456789012@Outlook.com", "zzzzzzzzzz", "True", "1", "smtp-mail.outlook.com", "2", "465", "30", "excellearning@Outlook.com") ' This line takes a long time
' GMX
Call ScrudOverFlowDemolition("1234567890@gmx.net", "fffffffffffff", "True", "1", "mail.gmx.net", "2", "465", "30", "GiMiCDOMsg@gmx.net")
Call ScrudOverFlowDemolition("12345678901234@gmx.net", "xxxxxx", "True", "1", "mail.gmx.net", "2", "465", "30", "Doc.AElstein@gmx.net")
Call ScrudOverFlowDemolition("12345@gmx.com", "966455535", "True", "1", "mail.gmx.com", "2", "465", "30", "Vixer@gmx.com")
' AOL
Call ScrudOverFlowDemolition("123456789@aol.com", "dddddddddd", "True", "1", "smtp.aol.com", "2", "587", "30", "aliarseol@aol.com")
' German Telekom
Call ScrudOverFlowDemolition("12345@t-online.de", "cccccccccc", "True", "1", "securesmtp.t-online.de", "2", "465", "30", "Jayae@t-online.de")
Call ScrudOverFlowDemolition("12345678901@t-online.de", "ddddddddddd", "True", "1", "securesmtp.t-online.de", "2", "465", "30", "CDOMsgTest@t-online.de")
Call ScrudOverFlowDemolition("12345678901234@t-online.de", "eeeeeeeeeeee", "True", "1", "securesmtp.t-online.de", "2", "465", "30", "CDOMsgScrotum@t-online.de")
'
If CunFikaNation <> "" Then Let CunFikaNation = Left(CunFikaNation, Len(CunFikaNation) - 2) ' I do not need the last vbCr & vbLf
Rem 2 Store the final string Configuration parameters
' 2a) In the Immediate window
Debug.Print CunFikaNation
' 2b) Send CunFikaNation to a text file, ( the file will be made if it does not exist, or it will be overwritten if it does exist
Dim Highway2 As Long: Let Highway2 = FreeFile(0) '
Open ThisWorkbook.Path & "" & "CunFikaNation " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Output As #Highway2 ' Text file will be made if not there
Print #Highway2, CunFikaNation
Close Highway2
' 2c) Using a function to get the string in a form which can be hardcoded into a VBA macro
' 2c)(i) direct use of CunFikaNation in function
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(CunFikaNation) ' http://www.excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11016&viewfull=1#post11016
' 2c)(ii) indirect use ater retreiving from the text file
Open ThisWorkbook.Path & "" & "CunFikaNation " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Binary As #Highway2
Let CunFikaNation = Space$(LOF(Highway2)) ' sets buffer to Length Of File : Space$(LOF(1)) creates a string the size of the file. LOF and Space$ is to initialize the string to a given length
Get #Highway2, , CunFikaNation ' fits exactly
Close Highway2
Let CunFikaNation = Left(CunFikaNation, Len(CunFikaNation) - 2) ' There appears to be an extra 2 characters, vbCr & vbLf , added to the string which we don't want so we effectiuvely chop off the last two characters
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(CunFikaNation) ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11818&viewfull=1#post11818 http://www.excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11016&viewfull=1#post11016
' 2c)(iii) Paste to a cell
Let ThisWorkbook.Worksheets.Item(1).Range("A1").Value = CunFikaNation
End Sub
'
' https://stackoverflow.com/questions/58525487/excel-vba-cdo-message-email-sending-accounts-work-less-and-less?noredirect=1#comment103375857_58525487
' ' Allow access to deep down cods wollops from Microsoft to collaborating in particular in the form of messaging. An available library of ddl library functions and associated things is available on request, the Microsoft CDO for Windows 2000. We require some of these ' CDO is an object library that exposes the interfaces of the Messaging Application Programming Interface (MAPI). API: interfaces that are fairly easy to use from a fairly higher level from within a higher level programming language. In other words this allows you to get at and use some of the stuff to do with the COM OLE Bollocks from within a programming language such as VBA API is often referring loosely to do with using certain shipped with Windows software in Folders often having the extension dll. This extension , or rather the dll stands for direct link libraries. These are special sort of executable files of functions shared by many other (Windows based usually) sof
'_- Program_(ii) "sendusername" , "sendpassword" , "smtpusessl" , "smtpauthenticate" , "smtpserver" , "sendusing" , "smtpserverport" , "smtpconnectiontimeout"
Sub ScrudOverFlowDemolition(ByVal UsrNme As String, ByVal PssWrd As String, ByVal SlutPussly As String, ByVal PatheticCake As String, ByVal ServiceChef As String, ByVal WayntkerUsed As String, ByVal ConnectingDoor As String, ByVal WaitSecs As String, ByVal Snd_Frm As String)
'Rem1 The deep down fundamental stuff , which includes stuff been there the longest goes by the name of Component Object Model. Stuff which is often, but not always, later stuff, or at a slightly higher level of the computer workings, or slightly more to a specific application ( an actual running "runtime" usage / at an instance in time , "instance of" ) orientated goes to the name of Object Linking and Embedding. At this lower level, there are protocols for communicating between things, and things relate are grouped into the to Office application available Library, CDO. An important object there goes by the name of Message.
'Rem 1) Library made available ====================#
With CreateObject("CDO.Message") ' Folders mostly but not always are in some way referenced using dll, either as noted with the extension or maybe refered to as dll Files or dll API files.
'Rem 2 ' Intraction protocols are given requird infomation and then set
'2a) 'With --------------------* my Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) which are used and items configured for the Exchange at Microsoft’s protocol thereof; http://schemas.microsoft.com/cdo/configuration/ ......This section provides the configuration information for the remote SMTP server
Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" ' Linking Configuration Data : defines the majority of fields used to set configurations for various Linking Collaboration (LCD) Objects Cods Wollops: These configuration fields are set using an implementation of the IConfiguration.Fields collection. https://msdn.microsoft.com/en-us/library/ms872853(v=exchg.65).aspx
.Configuration(LCD_CW & "smtpusessl") = SlutPussly ' ' ' HTTPS (Hyper Text Transfer Protocol Secure) appears in the URL when a website is secured by an SSL certificate. The details of the certificate, including the issuing authority and the corporate name of the website owner, can be viewed by clicking on the lock symbol on the browser bar. in short, it's the standard technology for keeping an internet connection secure and safeguarding any sensitive data that is being sent between two systems, preventing criminals from reading and modifying any information transferred, including potential personal details. ' SSL protocol has always been used to encrypt and secure transmitted data
.Configuration(LCD_CW & "smtpauthenticate") = PatheticCake ' ... possibly this also needed .. When you also get the Authentication Required Error you can add this three lines.
' ' Sever info
.Configuration(LCD_CW & "smtpserver") = ServiceChef ' "smtp.gmail.com" ' "securesmtp.t-online.de" '"smtp.gmail.com" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" 465 SMTP is just used to mean the common stuff..... Simple Mail Transport Protocol (SMTP) server is used to send outgoing e-mails. The SMTP server receives emails from your Mail program and sends them over the Internet to their destination.
' The mechanism to use to send messages.
.Configuration(LCD_CW & "sendusing") = WayntkerUsed ' Based on the LCD_OLE Data Base of type DBTYPE_I4 , 2 will use the default account
.Configuration(LCD_CW & "smtpserverport") = ConnectingDoor ' 465 or 25 for t-online.de ' 465 'or 587 'or 25 ' The port of type somehow refered to by the last line
.Configuration(LCD_CW & "sendusername") = UsrNme ' .... "server rejected your response". AFAIK : This will happen if you haven't setup an account in Outlook Express or Windows Mail .... Runtime error '-2147220975 (800440211)': The message could not be sent to the SMTP server. The transport error code is 0x80040217. The server response is not available
.Configuration(LCD_CW & "sendpassword") = PssWrd
' Optional - How long to try ( End remote SMTP server configuration section )
.Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' Or there Abouts ;) :)
' Intraction protocol is Set/ Updated
.Configuration.fields.Update ' 'Not all infomation is given, some will have defaults. - possibly this might be needed initially .. .Configuration.Load -1 ' CDO Source Defaults
'End With ' -------------------* my Created LCDCW Library ( Linking Configuration Data Cods Wollups) which are used and items configured for the Exchange at Microsoft's protocol therof;
'2b) ' Data to be sent
.To = "123456789012@t-online.de"
.CC = "" ' 12345678901@gmail.com"
.BCC = ""
.From = Snd_Frm '
.Subject = "Hello from " & UsrNme & "" '
.TextBody = "Hi" & vbCr & vbLf & "Testing automated EMail sending. Please ignoor this EMail"
' add header for this Account in log text file.
Dim Highway1 As Long: Let Highway1 = FreeFile(0) 'range 1 – 255, inclusive - next free The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use. The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511. https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Open ThisWorkbook.Path & "" & "ScrudOverFlowDemolition " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, "EMail Address:""" & UsrNme & """" & vbCrLf
Close #Highway1
'Rem 3 Attemt the send
On Error GoTo Bed ' Intended to catch a possible predicted error in the next line when running the routine
.send
On Error GoTo 0
' Add to the log a note to the effect that this account was successful
Debug.Print "Done " & """" & UsrNme & """"
Open ThisWorkbook.Path & "" & "ScrudOverFlowDemolition " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, "Sended " & Format(Now(), "hh mm") & " " & vbCr & vbLf
Close #Highway1
'
' Add to the string of succesful accounts CDO config data, CunFikaNation
Let CunFikaNation = CunFikaNation & UsrNme & " " & PssWrd & " " & SlutPussly & " " & PatheticCake & " " & ServiceChef & " " & WayntkerUsed & " " & ConnectingDoor & " " & WaitSecs & " " & Snd_Frm & vbCr & vbLf
End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
Exit Sub ' Normal routine end for no error exceptional errected situation
Bed: ' Intended to catch an error when running the routine
' Add to the log a note to the effrect that this account was unsuccessful
Debug.Print "Not done " & """" & UsrNme & """" & " Error is " & Err.Number & ": " & Err.Description
Open ThisWorkbook.Path & "" & "ScrudOverFlowDemolition " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, "Fail " & Format(Now(), "hh mm") & " " & Err.Number & ": " & Err.Description & vbLf
Close #Highway1
' On Error GoTo -1: On Error GoTo 0 ' Do not need to do this as the code is ending
End Sub
' NOTE: This is an extra macro that can be used to fill the global variable, CunFikaNation . This can be useful in development since the global variable is often emptied. It is also useful for checking error handling in the next coding, since you can modify the text file, then refil the global variable , CunFikaNation from it
Sub GetthelastCunFikaNation()
Dim Highway2 As Long: Let Highway2 = FreeFile(0) 'range 1 – 255, inclusive - next free The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use. The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511. https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Open ThisWorkbook.Path & "" & "CunFikaNation " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Binary As #Highway2
Let CunFikaNation = Space$(LOF(Highway2)) ' sets buffer to Length Of File : Space$(LOF(1)) creates a string the size of the file. LOF and Space$ is to initialize the string to a given length
Get #Highway2, , CunFikaNation ' fits exactly
Close Highway2
Let CunFikaNation = Left(CunFikaNation, Len(CunFikaNation) - 2) ' There appears to be an extra 2 characters, vbCr & vbLf , added to the string which we don't want so we effectiuvely chop off the last two characters
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(CunFikaNation) ' http://www.excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11016&viewfull=1#post11016
' 2c)(iii) Paste to a cell
' Let ThisWorkbook.Worksheets.Item(1).Range("A1").Value = CunFikaNation ' This is already done by Call WtchaGot_Unic_NotMuchIfYaChoppedItOff( )
End Sub
' '_- Program_(iii)
Sub CallCDOSendMailAttempt()
Dim VlagaMir As Boolean ' This is set to True after an EMail is succcesful
Rem 1 make array for the configutration parameters of all EMail accounts
Dim SptACnt() As String: Let SptACnt() = Split(CunFikaNation, vbCr & vbLf, -1, vbBinaryCompare)
Rem 2 pass the config parameters to CDOSendMail until successful mail send
Dim Cnt As Long
For Cnt = 0 To UBound(SptACnt())
Dim CunFik() As String: Let CunFik() = Split(SptACnt(Cnt), " ", 9, vbBinaryCompare)
Call CDOSendMailAttempt(VlagaMir, CunFik(0), CunFik(1), CunFik(2), CunFik(3), CunFik(4), CunFik(5), CunFik(6), CunFik(7), CunFik(8))
If VlagaMir = True Then Exit Sub
Next Cnt
End Sub
' '_- Program_(iv)
Sub CDOSendMailAttempt(ByRef FlagerMe As Boolean, ByVal UsrNme As String, ByVal PssWrd As String, ByVal SlutPussly As String, ByVal PatheticCake As String, ByVal ServiceChef As String, ByVal WayntkerUsed As String, ByVal ConnectingDoor As String, ByVal WaitSecs As String, ByVal Snd_Frm As String)
'Rem1 The deep down fundamental stuff , ...
'Rem 1) Library made available ====================#
With CreateObject("CDO.Message") ' Folders mostly but not always are in some way referenced using dll, either as noted with the extension or maybe refered to as dll Files or dll API files.
'Rem 2 ' Intraction protocols are given requird infomation and then set
'2a) 'With --------------------* my Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) which are used and items configured for the Exchange at Microsoft’s protocol thereof; http://schemas.microsoft.com/cdo/configuration/ ......This section provides the configuration information for the remote SMTP server
Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" ' Linking Configuration Data : defines the majority of fields used to set configurations for various Linking Collaboration (LCD) Objects Cods Wollops: These configuration fields are set using an implementation of the IConfiguration.Fields collection. https://msdn.microsoft.com/en-us/library/ms872853(v=exchg.65).aspx
.Configuration(LCD_CW & "smtpusessl") = SlutPussly ' ' ' HTTPS (Hyper Text Transfer Protocol Secure) appears in the URL when a website is secured by an SSL certificate. The details of the certificate, including the issuing authority and the corporate name of the website owner, can be viewed by clicking on the lock symbol on the browser bar. in short, it's the standard technology for keeping an internet connection secure and safeguarding any sensitive data that is being sent between two systems, preventing criminals from reading and modifying any information transferred, including potential personal details. ' SSL protocol has always been used to encrypt and secure transmitted data
.Configuration(LCD_CW & "smtpauthenticate") = PatheticCake ' ... possibly this also needed .. When you also get the Authentication Required Error you can add this three lines.
' ' Sever info
.Configuration(LCD_CW & "smtpserver") = ServiceChef ' "smtp.gmail.com" ' "securesmtp.t-online.de" '"smtp.gmail.com" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com" "smtp-mail.outlook.com" "smtp.live.com" "securesmtp.t-online.de" 465 SMTP is just used to mean the common stuff..... Simple Mail Transport Protocol (SMTP) server is used to send outgoing e-mails. The SMTP server receives emails from your Mail program and sends them over the Internet to their destination.
' The mechanism to use to send messages.
.Configuration(LCD_CW & "sendusing") = WayntkerUsed ' Based on the LCD_OLE Data Base of type DBTYPE_I4 , 2 will use the default account
.Configuration(LCD_CW & "smtpserverport") = ConnectingDoor ' 465 or 25 for t-online.de ' 465 'or 587 'or 25 ' The port of type somehow refered to by the last line
.Configuration(LCD_CW & "sendusername") = UsrNme ' .... "server rejected your response". AFAIK : This will happen if you haven't setup an account in Outlook Express or Windows Mail .... Runtime error '-2147220975 (800440211)': The message could not be sent to the SMTP server. The transport error code is 0x80040217. The server response is not available
.Configuration(LCD_CW & "sendpassword") = PssWrd
' Optional - How long to try ( End remote SMTP server configuration section )
.Configuration(LCD_CW & "smtpconnectiontimeout") = 30 ' Or there Abouts ;) :)
' Intraction protocol is Set/ Updated
.Configuration.fields.Update ' 'Not all infomation is given, some will have defaults. - possibly this might be needed initially .. .Configuration.Load -1 ' CDO Source Defaults
'End With ' -------------------* my Created LCDCW Library ( Linking Configuration Data Cods Wollups) which are used and items configured for the Exchange at Microsoft's protocol therof;
'2b) ' Data to be sent
.To = "1234567890123@t-online.de"
.CC = "" ' 1234567890@gmail.com"
.BCC = ""
.From = Snd_Frm ' """Avinash_gMail_Send"" <" & UsrNme & ">"
.Subject = "Hello from " & UsrNme & "" ' "Pro für " & DieseArbeitsmappe1.LisWbProWb.Name
.TextBody = "Hi" & vbCr & vbLf & "Testing automated EMail sending. Please ignoor this EMail"
'.HTMLBody = MyLengthyStreaming
'.htmlbody = ProTble
' Add text file attachments
' make file if it does not exist, or add to it
Dim Highway1 As Long: Let Highway1 = FreeFile(0) 'range 1 – 255, inclusive - next free The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use. The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511. https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Open ThisWorkbook.Path & "" & "CDOSendMailAttempt " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, "EMail Address:""" & UsrNme & """" & vbCrLf
Close #Highway1
'Dim DirTxtFl As String: Let DirTxtFl = Dir(ThisWorkbook.Path & "" & "*.txt")
' Do While DirTxtFl <> ""
' If VBA.Left$(DirTxtFl, 7) = "Avinash" Then .AddAttachment ThisWorkbook.Path & "" & DirTxtFl
' Let DirTxtFl = Dir
' Loop
'Rem 3 Do it
On Error GoTo Bed ' Intended to catch a possible predicted error in the next line when running the routine
.send
On Error GoTo 0
' MsgBox Prompt:="Done " & """" & UsrNme & """" & "(with " & SmptySvrPrt & ")" ' This will typically give either "Done (with 25)" or "Done (with 465)" if the routine worked
Debug.Print "Done " & """" & UsrNme & """"
Open ThisWorkbook.Path & "" & "CDOSendMailAttempt " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, "Sended " & Format(Now(), "hh mm") & " " & vbCr & vbLf
Close #Highway1
End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
Let FlagerMe = True ' Boolean set to True after a succesful run of macro
Exit Sub ' Normal succesful run of macro end
Bed:
Debug.Print "Not done " & """" & UsrNme & """" & " Error is " & Err.Number & ": " & Err.Description
Open ThisWorkbook.Path & "" & "CDOSendMailAttempt " & Format(Date, "dddd dd mmmm yyyy") & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, "Fail " & Format(Now(), "hh mm") & " " & Err.Number & ": " & Err.Description & vbLf
Close #Highway1
' ' On Error GoTo -1 ' This takes out of the exceptional error handling state, so that the Error handler will work again ... not needed as the sub ends
' Ending Sub with FagerMe still set at False
End Sub