Excel VBA CDO邮件发送帐户的工作越来越少…;

Excel VBA CDO邮件发送帐户的工作越来越少…;,vba,cdo.message,Vba,Cdo.message,赫罗 我一直在尝试使用一些CDO消息VBA编码来自动发送短电子邮件。所有这些都是私人使用的,每天发送的电子邮件不会超过几封。这封电子邮件是写给我家人的,或者是我与之共享代码的其他人的,例如在免费帮助论坛上。 我的宏肯定能工作,而且在过去非常可靠。 最近,我发现越来越多的情况下,电子邮件帐户不再工作。因此,我必须用另一个帐户替换发送电子邮件的帐户。 我的账户快用完了。 新帐户要么不工作,要么只工作几次,然后在进一步尝试时给出各种错误。 我正在使用的同一提供商的不同帐户都具有相同的设置,并且在某些情

赫罗

我一直在尝试使用一些CDO消息VBA编码来自动发送短电子邮件。所有这些都是私人使用的,每天发送的电子邮件不会超过几封。这封电子邮件是写给我家人的,或者是我与之共享代码的其他人的,例如在免费帮助论坛上。 我的宏肯定能工作,而且在过去非常可靠。 最近,我发现越来越多的情况下,电子邮件帐户不再工作。因此,我必须用另一个帐户替换发送电子邮件的帐户。 我的账户快用完了。 新帐户要么不工作,要么只工作几次,然后在进一步尝试时给出各种错误。 我正在使用的同一提供商的不同帐户都具有相同的设置,并且在某些情况下以前以类似的方式使用过。但有些帐户仍然在CDO消息发送中工作,其他帐户则不工作。哪些工作和哪些不工作似乎是随机的,工作的人越来越少

我找不到来自电子邮件提供商的任何帮助,除了无法解决我的问题的自动问答,或者无用的浪费时间的电话帮助热线

任何人都可以推荐一个电子邮件帐户提供商,他们发现该提供商的帐户在CDO消息宏中保持一致

我想我知道大多数必要的设置,因为我以前已经能够让帐户正常工作。我猜可能是垃圾邮件软件被收紧了,作为一种副产品,真正的使用往往会被错误地阻止……我猜自动使用帐户更可能引起怀疑

gmail对我来说总是非常可靠的。但现在10个账户中有7个不起作用。我不能再注册了,因为他们限制每个确认电话号码只能注册几次。所以我预计很快gmail将不再是我的选择

雅虎和yandex上的新账户通常会运行几次,然后停止运行。偶尔他们会再次工作

我目前唯一一直在工作的提供商是一家小型德国电信提供商。但根据Sod的法律,我需要的一些电子邮件功能在大多数其他提供商上都可用,……但在这家德国提供商上不可用!!:--(

我可以在不同的位置访问不同的计算机和互联网连接。我在不同的地方得到类似的结果。因此,我不认为我的互联网连接是间歇性问题。我的意思是,当前一直工作的帐户将在不同的地方工作,并且具有不同的功能高质量的互联网连接

我的猜测是,问题来自于自动化的安全措施,这对于不同的提供商将是不同的,因此,这就是为什么我想询问其他人在电子邮件帐户和CDO消息发送编码方面的经验

在所有情况下,停止使用CDO编码的帐户仍然可以手动工作。我知道,当从新位置使用帐户时,通常会出现临时阻塞。这只会导致临时阻塞。这不是我的问题。这些临时阻塞也会发生在工作帐户上,我知道如何处理它们

Thx 艾伦

为我的最后一个答案编码()

编辑:答案帖子被隐藏了!-这是它的副本:

选项显式
“”-(ii)“发送用户名”、“发送密码”、“smtpusessl”、“smtpauthenticate”、“smtpserver”、“发送使用”、“smtpserverport”、“smtpconnectiontimeout”
'次级筛选流程拆除(ByVal UsrNme作为字符串,ByVal PssWrd作为字符串,ByVal SlutPussly作为字符串,ByVal PathyticCake作为字符串,ByVal ServiceChef作为字符串,ByVal WayntkerUsed作为字符串,ByVal ConnectionDoor作为字符串,ByVal WaitSecs作为字符串,ByVal Snd_Frm作为字符串)
Dim CunFik()作为字符串“CDO帐户配置”
Dim CunFik作为字符串“CDO帐户配置”,由vbCr和vbLf分隔的CunFik(x)是“sendusername”“sendpassword”“smtpusessl”“smtpauthenticate”“smtpserver”“sendusing”“smtpserverport”“smtpconnectiontimeout”
"(一)
“(”(ii)ScrudOverFlow.(“发送用户名”、“发送密码”、“smtpusessl”、“smtpauthenticate”、“smtpserver”、“发送使用”、“smtpserverport”、“smtpconnectiontimeout”、.From)
子测试调用
让CunFikaNation=“”
Rem 1帐户及其配置参数的集合
“gmail
请致电ScrudoverFlowDemovation(“12345678900123456789.com”、“xxxxxxxxxx”、“True”、“1”、“smtp.gmail.com”、“2”、“465”、“30”和“ExcelVBAExp@gmail.com")
调用ScrudorFlowDemovation(“1234567890@gmail.com“,”xxxxxxxxxx“,”真“,”1“,”smtp.gmail.com“,”2“,”465“,”30“,”mail2taste@gmail.com")
调用ScrudorFlowDemovation(“1234567890@gmail.com“,”xxxxxxxxx“,”真“,”1“,”smtp.gmail.com“,”2“,”25“,”30“,”mail2taste@gmail.com")
调用ScrudorFlowDemovation(“1234567890123456@gmail.com“,”xxxxxxxxx“,”真“,”1“,”smtp.gmail.com“,”2“,”465“,”30“,”excellearning12@gmail.com")
调用ScrudorFlowDemovation(“12345678901@gmail.com“,”xxxxxxx“,”真“,”1“,”smtp.gmail.com“,”2“,”465“,”30“,”JaneAmbrose1958@gmail.com")
调用ScrudorFlowDemovation(“1234567890@gmail.com“,”xxxxxxx“,”真“,”1“,”smtp.gmail.com“,”2“,”465“,”30“,”CDOMsgExp@gmail.com")
调用ScrudorFlowDemovation(“123456789@gmail.com“,”xxxxxxx“,”真“,”1“,”smtp.gmail.com“,”2“,”25“,”30“,”CDOMsgExp@gmail.com")
“Yandex
调用ScrudorFlowDemovation(“xxxxxxxxxxx@yandex.com“,”xxxxxxxxx“,”真“,”1“,”smtp.yandex.com“,”2“,”465“,”30“,”developmentstest@yandex.com")
调用ScrudorFlowDemovation(“eeeeeeeeeee@yandex.com“,”ahetkdkjhdhj“,”真“,”1“,”smtp.yandex.com“,”2“,”465“,”30“,”developmentstest@yandex.com")
请致电ScrudoverFlowDemolision(“123456789
    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://docs.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://docs.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://docs.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