Another item of interest, at least from my point-of-view, is that last week this same app sent out 137 emails with double attachments without any issues whatsoever. EDIT: 2/4 Could this issue be related to the version of Windows? The 137 emails noted were sent from a Windows 11 system, whereas the issue sited in the OP occurred on a clients Window 10 system. My understanding is the CDO is an API to the Windows MAPI, putting the issue partially in the system realm?
The snippet of code that initiates the "send":
Code:
DoCmd.Hourglass True
With rsNewsLtr
If .RecordCount > 0 Then
.MoveFirst
While Not .EOF
strRecipient = ![e-MailAddr]
strFName = !FirstName
strLName = !LastName
If bolBdyTxtOnly <> True Then
If bolCont = True Then Call SendUsingCDOMail(strSubj, strRecipient, "Dummy", Replace(strMsgBody, "NnNnNnNn", strFName))
End If
intNLCount = intNLCount + 1
.MoveNext
Wend
End If
End With
DoCmd.Hourglass False
Screenshot of the error:
The CDO module I use: (Mixture of my code mixed with Paul's)
Code:
Public Sub SendUsingCDOMail(strSubj, strToEMA, strAttName, strBody)
'*=*=*=*=*=(12/27/2022 Code courtesy of Paul Baldarelli)=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
' E.g., SendMail("TMS Offerings for 2022", "wcsreno@gmail.com", strStmtPDFName, strBody)
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Dim mail As CDO.message
Dim config As CDO.Configuration
Dim strAuthSender As String
Dim strReplyTo As String
Dim strAttmts() As String
Dim I As Integer
Set mail = CreateObject("CDO.Message")
Set config = CreateObject("CDO.Configuration")
config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
config.Fields(cdoSMTPServer).Value = Nz(DLookup("CDOSMTP", "InstProperties"))
config.Fields(cdoSMTPAuthenticate).Value = 1
strReplyTo = Nz(DLookup("CDOReplyTo", "InstProperties"))
strAuthSender = Nz(DLookup("CDOEMA", "InstProperties"))
config.Fields(cdoSendUserName).Value = strAuthSender
config.Fields(cdoSendPassword).Value = GetAppPW(Nz(DLookup("CDOPW", "InstProperties")))
config.Fields(cdoSMTPServerPort).Value = 465
config.Fields(cdoSMTPUseSSL).Value = True
config.Fields.Update
Set mail.Configuration = config
With mail
.To = strToEMA
.From = strAuthSender
.ReplyTo = strReplyTo
.Subject = strSubj
.TextBody = strBody
If (strAttName <> "Dummy") And (Not IsNull(strAttName)) Then
strAttmts = Split(strAttName, ";")
For I = 0 To UBound(strAttmts)
If Len(Dir(strAttmts(I))) > 0 Then
.AddAttachment strAttmts(I)
Else
MsgBox "Specified attachment " & strAttmts(I) & " not found."
Exit Sub
End If
Next I
End If
.send
End With
Set config = Nothing
Set mail = Nothing
End Sub