Good day all,
First post here.
Like the title says, I'm trying to fix an error I keep getting after clicking on "Send" button to send email to subject users, but it keeps coming up with error 2295.
Here's the code:
First post here.
Like the title says, I'm trying to fix an error I keep getting after clicking on "Send" button to send email to subject users, but it keeps coming up with error 2295.
Here's the code:
Code:
Option Compare Database
Public Sub SetEnabled(bool As Boolean)
Dim c As Control
For Each c In Me.Controls
If c.ControlType = acCommandButton Then
c.Enabled = bool
End If
Next c
End Sub
Private Sub btnSend_Click()
' Get the COC
Dim strEmail As String
Dim strCCEmail As String
Dim strSubject As String
Dim strBody As String
' Make sure there is an email
If IsNull(Me.parent.fldMemberID) Or IsEmpty(Me.parent.fldMemberID) Then
Err.Number = "94"
GoTo ErrHandle
End If
' Get email
strEmail = Nz(DLookup("fldEmail", "tblMember", "ID = " & Me.parent.fldMemberID), "")
' Check for email
If IsNull(strEmail) Or IsEmpty(strEmail) Or Not Len(strEmail) > 0 Then
Err.Number = "94"
GoTo ErrHandle
End If
' The COC Email
strCCEmail = IIf(IsNull(Me.parent.fldSameoDate), "", DLookup("fldEmail", "tblCCEmail", "fldCC = 'SAMEO'") & ";") & _
IIf(IsNull(Me.parent.fldSameoDate), "", DLookup("fldEmail", "tblCCEmail", "fldCC = 'FS'") & ";") & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO1A'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO1'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO2'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO1B'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO2A'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ASO2B'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'ARO'") & ";" & _
DLookup("fldEmail", "tblCCEmail", "fldCC = 'AMCRO'")
' Get sent
With CurrentDb.OpenRecordset("SELECT * FROM tblAmmisObservationSent WHERE " & "fldObservationID = " & Me.parent.ID)
If .EOF = True Then
' Subject
strSubject = "AMMIS Observation for " & Me.parent.fldAmmisd349 & " - DO NOT DELETE!"
' Body
strBody = "An AMMIS Correction is required for Form Serial Number " & Me.parent.fldAmmisd349 & " due to the following reason(s): " & vbNewLine & vbNewLine & _
"- " & Me.parent.fldObservation & vbNewLine & vbNewLine & vbNewLine & _
"______________________________________________________________________________________________________" & vbNewLine & _
"Please open a new CF349 with 'AMMIS' as the Supp Data and rectifty the issue(s) stated. Be sure to link it to the original form (" & Me.parent.fldAmmisd349 & ")." & vbNewLine & _
"Once this AMMIS Observation has been corrected, please reply to this email with the new Form Serial Number." & vbNewLine & _
"" & vbNewLine & _
"Please ensure to look at the Squadron MAP AMCRO Examples prior to calling AMCRO for guidance." & vbNewLine & _
"" & vbNewLine & _
"Thank you for your assistance." & vbNewLine & _
"______________________________________________________________________________________________________"
Else
.MoveLast
' Subject
strSubject = "Reminder - You have an Open AMMIS Observation for " & Me.parent.fldAmmisd349 & " - DO NOT DELETE!"
' Body
strBody = "An AMMIS Correction is required for Form Serial Number " & Me.parent.fldAmmisd349 & " due to the following reason(s): " & vbNewLine & vbNewLine & _
"- " & Me.parent.fldObservation & vbNewLine & _
"______________________________________________________________________________________________________" & vbNewLine & _
"Please open a new CF349 with 'AMMIS' as the Supp Data and rectifty the issue(s) stated. Be sure to link it to the original form (" & Me.parent.fldAmmisd349 & ")." & vbNewLine & _
"Once this AMMIS Observation has been corrected, please reply to this email with the new Form Serial Number." & vbNewLine & _
"This has been opened since " & Me.parent.fldOpenedDate & ", and has been sent " & .RecordCount + 1 & " time(s)!" & vbNewLine & _
"" & vbNewLine & _
"Please ensure to look at the Squadron MAP AMCRO Examples prior to calling AMCRO for guidance." & vbNewLine & _
"" & vbNewLine & _
"Thank you for your assistance." & vbNewLine & _
"______________________________________________________________________________________________________"
End If
' Attached file name
tempFN = Me.parent.fldAmmisd349 & ".pdf"
On Error GoTo ErrHandle
DoCmd.OpenReport "AmmisForm", acViewPreview, , "tblAmmisObservations.ID = " & Me.parent.ID, acHidden
DoCmd.SendObject acSendReport, "AmmisForm", acFormatPDF, strEmail, strCCEmail, , strSubject, strBody, True
.AddNew
![fldObservationID] = Me.parent.ID
![fldSentDate] = FormatDateTime(Now(), 2)
.Update
End With
' Update the follow up
Me.parent.fldFollowUpDate = Format(DateAdd("d", 60, Date), "dd-mm-yyyy")
GoTo EOF
ErrHandle:
Select Case Err.Number
Case "94"
MsgBox "Problem With Email Address!", vbCritical, Err.Number
Case "2501"
MsgBox "Email Cancelled!", vbCritical, Err.Number
Case Else
MsgBox Err.Description, vbCritical, Err.Number
End Select
EOF:
DoCmd.Close acReport, "AmmisForm"
End Sub
Private Sub btnPrint_Click()
On Error Resume Next
If MsgBox("Do you wish to view (Yes) or print (No) the report?", vbYesNo, "Generate Report") = vbYes Then
DoCmd.OpenReport "AmmisForm", acViewPreview, , "tblAmmisObservations.ID = " & Me.parent.ID, acDialog
Else
DoCmd.OpenReport "AmmisForm", acViewNormal, , "tblAmmisObservations.ID = " & Me.parent.ID
End If
End Sub
Private Sub btnDeleteRecord_Click()
On Error Resume Next
If MsgBox("The current record will be deleted. Is this OK?", vbQuestion + vbYesNo) = vbYes Then
' Get the current ID
curID = Me.parent.ID
' Get the position
pos = Me.parent.CurrentRecord - 1
pos = IIf(pos < 0, 0, pos)
' Make sure that we actually have an ID
If DCount("ID", "tblAmmisObservations", "ID=" & curID) = 1 Then
DoCmd.SetWarnings False
' Delete the observations sent by the record
CurrentDb.Execute "DELETE * FROM tblAmmisObservations WHERE ID=" & curID, dbFailOnError
DoCmd.SetWarnings True
' Else there wasn't an ID as specified
Else
MsgBox "Couldn't find the ID: " & curID & " in the DB!, canceling the delete!", vbInformation
End If
End If
' Requery the parent
Me.parent.Requery
' Goto the record
DoCmd.GoToRecord acDataForm, Me.parent.Name, acGoTo, pos
End Sub
Private Sub btnEdit_Click()
DoCmd.OpenForm "AmmisObservation", , , "ID = " & Me.parent.ID, , acDialog
End Sub