After 15 years my databases is not letting me email any more!
Question
-
I am getting this error when trying to email
I have not altered my query. I have tested earlier versions of my database and they are all giving me the same error!
Any Help Please ..............Regards Bob
Private Sub SendMailButton_Click()
If IsNull(tbEmailOption.value) = True Or tbEmailOption.value = vbNullString Then
MsgBox "Please make a Email Format Selection!" & vbCrLf & "Close and Re-Open Statements", vbApplicationModal + vbInformation + vbOKOnly
Exit Sub
End If
On Error GoTo Err_Command35_Click
If Me.Dirty = True Then
Me.Dirty = False
Dim myfile1 As String, myfile2 As String, myfile3 As String
End If
Dim mydir As String
mydir = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, sndReport As String, strCompany As String
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp As Integer, tbAmount As String
Dim strFormat As String
Dim mytot As Long
mytot = DCount("[InvoiceID]", "qrySelInvoices", "")
Select Case Me.tbEmailOption.value
Case "ADOBE"
strFormat = acFormatPDF
myfile1 = mydir & "Statement.pdf"
myfile2 = mydir & "Invoices.pdf"
myfile3 = mydir & "Terms_and_Conditions.pdf"
Case "WORD"
strFormat = acFormatRTF
myfile1 = mydir & "Statement.rtf"
myfile2 = mydir & "Invoices.rtf"
myfile3 = mydir & "Terms_and_Conditions.rtf"
Case "SNAPSHOT"
strFormat = acFormatSNP
myfile1 = mydir & "Statement.SNP"
myfile2 = mydir & "Invoices.SNP"
myfile3 = mydir & "Terms_and_Conditions.SNP"
Case "TEXT"
strFormat = acFormatTXT
myfile1 = mydir & "Statement.txt"
myfile2 = mydir & "Invoices.txt"
myfile3 = mydir & "Terms_and_Conditions.txt"
Case "HTML"
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoices.htm"
myfile3 = mydir & "Terms_and_Conditions.htm"
Case Else ' catch all others
strFormat = acFormatRTF
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoices.htm"
myfile3 = mydir & "Terms_and_Conditions.htm"
End Select
Select Case Me.OpenArgs
Case "OwnerStatement"
sndReport = "Client_Statement"
lngID = Nz(Me.cbOwnerName.Column(0), 0)
strMail = OwnerEmailAddress(lngID)
tbAmount = Nz(Me.cbOwnerName.Column(5), 0)
strBodyMsg = "To: "
strBodyMsg = strBodyMsg & Nz(DLookup("[ClientTitle]", "tblOwnerInfo", "[OwnerID]=" & lngID), " ") & " "
strBodyMsg = strBodyMsg & Nz(DLookup("[OwnerFirstName]", "tblOwnerInfo", "[OwnerID]=" & lngID), " ") & " "
strBodyMsg = strBodyMsg & Nz(DLookup("[OwnerLastName]", "tblOwnerInfo", "[OwnerID]=" & lngID), "Client")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement/Invoices, Dated:" & " " & Format(Date, "d-mmm-yyyy") & Chr(10) & "Your Statement Total: " & Format(tbAmount, "$ #,##.00") & Chr(10) & Chr(10) & Nz(DLookup("[EmailMessage]", "tblCompanyInfo"), "") & eMailSignature("Best Regards", True) & Chr(10) & Chr(10) & DownloadMessage("PDF") _
DoCmd.OutputTo acOutputReport, sndReport, strFormat, myfile1, False
If ckbTerms = True Then
DoCmd.OutputTo acOutputReport, "TermsAndConditions", strFormat, myfile3, False
End If
If mytot > 0 And ckbStateOnly = False Then
DoCmd.OutputTo acOutputReport, "Invoice", strFormat, myfile2, False
End If
CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID & " AND " & cbOwnerName.Column(0), dbFailOnError 'OwnerChange
Dim myitem As Object ' Outlook.MailItem
Dim myout As Object 'Outlook.Application
Set myout = CreateObject("Outlook.Application") ' New Outlook.Application
Set myitem = myout.CreateItem(0) '(olMailItem)
With myitem
.To = strMail
.Cc = Nz(DLookup("EmailCC", "tblOwnerInfo", "OwnerID = " & lngID), "")
.Bcc = Nz(DLookup("EmailBCC", "tblOwnerInfo", "OwnerID = " & lngID), "")
.Subject = "Your Statement/Invoice" & " from " & Nz(DLookup("[CompanyName]", "tblCompanyInfo"))
.Body = strBodyMsg 'EditMessage:=blEditMail
.Attachments.Add myfile1
If ckbTerms = True Then
.Attachments.Add myfile3
End If
If mytot > 0 And ckbStateOnly = False Then
.Attachments.Add myfile2
End If
'On Error Resume Next
.Send
'On Error GoTo ErrorHandler
End With
Set myitem = Nothing
Set myout = Nothing
cbOwnerName.SetFocus
Case Else
Exit Sub
End Select
ExitProc:
Exit_Command35_Click:
Exit Sub
Err_Command35_Click:
MsgBox Err.Description
Resume Exit_Command35_Click
Resume ExitProc
End Sub
xxx
Answers
All replies
-
This fixed it, went back to October 30 update version and not Nov 12
Would be the bottom code
xxx
