Herllo
I have been trying to use some CDO Message VBA coding to automate sending short Emails. All is for private use, and never more than a couple of Emails per day. Either the Emailing is for people in my family, or other peple who I am sharing the coding with , for example on free help forums. My macros definitely work, and in the past were very reliable. More recently I am finding that more and more often an Email account no longer works. So I have to replace the sending EMail account with another. I am running out of accounts that work. New accounts either do not work, or work just a few times, and then on further attempts give various errors. Different accounts from the same provider which I am using all have identical settings and in some cases have been used previously in similar ways. But some accounts still work in the CDO message sending, others don’t. It seems random which ones work and which don’t, with a growing tendency for less and less to work.
I cannot find any help from the EMail providers other than automated Q / A which does not address my problem, or useless time wasting telephone help lines
Can anyone recommend an Email account provider whose accounts they are finding to work consistently in a CDO Message macro.
I think I know about most of the required settings, since I have been able to get the accounts working previously. I am guessing that maybe spam software is being tightened up and as a by product genuine use gets more often blocked by mistake… and I guess that automated use of accounts is more likely to arouse suspicion.
gmail was always very reliable for me. But now 7 out of 10 accounts are not working. I cannot register anymore, as they limit you to just a few registrations per confirming telephone number. So I expect soon that gmail will no longer be an option for me.
New accounts on yahoo and yandex usually work a few times then stop working. Once in a while they occasionally work again.
The only provider I have currently working consistently is a small German telecom provider. But as per Sod’s Law, some Email features that I need are available on most other providers, ..but not on this German one!! :--(
I have access to a few different computers and internet connection possibilities at different locations. I get similar results in different places. So I do not think it is intermittent problems to do with my internet connection. What I mean by this is that an account that currently is working consistently will work in various places with different quality internet connections.
My guess is that the problem is coming from automated security measures, which will be different for different providers, so that is why I an asking for other peoples experience with Email accounts and CDO Message sending coding.
In all cases, an account that stops working in the CDO coding, still works manually. I am aware that there are temporary blocks often made when accounts are used from new locations. This only causes a temporary block. This is not my issue. These temporary blocks also occur on the working accounts, and I know how to deal with them.
Thx Alan
Coding for my last answer ( Excel VBA CDO Message Email Sending accounts work less and less… )
EDIT: The answer post has been hidden! - here is a copy of it: 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", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "25", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxx", "True", "1", "smtp.gmail.com", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxx", "True", "1", "smtp.gmail.com", "2", "25", "30", "[email protected]")
' Yandex
Call ScrudOverFlowDemolition("[email protected]", "xxxxxxxxx", "True", "1", "smtp.yandex.com", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "ahetkdkjhddhj", "True", "1", "smtp.yandex.com", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "96lskKFHSHFDLHF", "True", "1", "smtp.yandex.com", "2", "465", "30", "[email protected]")
' Yahoo
Call ScrudOverFlowDemolition("[email protected]", "XXXXXXXX", "True", "1", "smtp.mail.yahoo.com", "2", "465", "30", "[email protected]")
' Outlook
Call ScrudOverFlowDemolition("[email protected]", "cccccccccc*", "True", "1", "smtp-mail.outlook.com", "2", "587", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "yyyyyyyy", "True", "1", "smtp-mail.outlook.com", "2", "587", "30", "[email protected]")
'Call ScrudOverFlowDemolition("[email protected]", "zzzzzzzzzz", "True", "1", "smtp-mail.outlook.com", "2", "465", "30", "[email protected]") ' This line takes a long time
' GMX
Call ScrudOverFlowDemolition("[email protected]", "fffffffffffff", "True", "1", "mail.gmx.net", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "xxxxxx", "True", "1", "mail.gmx.net", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "966455535", "True", "1", "mail.gmx.com", "2", "465", "30", "[email protected]")
' AOL
Call ScrudOverFlowDemolition("[email protected]", "dddddddddd", "True", "1", "smtp.aol.com", "2", "587", "30", "[email protected]")
' German Telekom
Call ScrudOverFlowDemolition("[email protected]", "cccccccccc", "True", "1", "securesmtp.t-online.de", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "ddddddddddd", "True", "1", "securesmtp.t-online.de", "2", "465", "30", "[email protected]")
Call ScrudOverFlowDemolition("[email protected]", "eeeeeeeeeeee", "True", "1", "securesmtp.t-online.de", "2", "465", "30", "[email protected]")
'
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 = "[email protected]"
.CC = "" ' [email protected]"
.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 = "[email protected]"
.CC = "" ' [email protected]"
.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