hi
This code was kindly create for me. when I tested it, it seemed to work great
now I have added more contacts in the contact table I see it is not working correctly
what this does is prepare to send a report from the "open issues" to ALL the people in the contacts file who have a report "assigned to" them.
what i really need it to do is prepare to send an e-mail to the people who have "active" reports in the "open issues" and it is assigned to them
any help will be apricated
file attached , if yousee the assigned to field you will see 2 names .when you select the report " open issues assigned to " you will see it will send a report to all 3 people in the contacts list which is not correct
thanks steve
[CODEPrivate Sub cboReports_AfterUpdate()
Dim strCriteria As String
Dim thisCriteria As String
Dim eMail As String
Dim Title As String
Dim Message As String
Dim i As Integer
DoCmd.OpenForm FormName:="ReportDialog", WindowMode:=acDialog
'* check if [TextReportOption] <> 0
If Me.TextReportOption <> 0 Then
strCriteria = "(1=1)" '(1=1) means it is always True, therefore returns all records
Select Case Me.TextReportOption
Case Is = 1 'Print Preview
'* Open the report with criteria
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=strCriteria
Case Is = 2 'Print
'* Open the report with criteria
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewNormal, WHERECONDITION:=strCriteria
Case Is = 3 'Email report
If cboReports = "Open Issues" Then
strCriteria = "[STATUS]=""ACTIVE"""
If DCount("1", "Issues", "Status=""Active""") <> 0 Then
With CurrentDb.OpenRecordset("SELECT DISTINCT [Assigned To] FROM [Issues] " & _
"WHERE [Status]=""Active""")
If Not (.BOF And .EOF) Then .MoveFirst
i = 0
While Not .EOF
i = i + 1
thisCriteria = strCriteria & " And [Assigned To]=" & Nz(.Fields(0).Value, 0)
eMail = DLookup("[E-mail Address]", "Contacts", "ID=" & Nz(.Fields(0).Value, 0))
'* close report if already open
If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
DoCmd.Close acReport, cboReports.Value
End If
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
'* this is a test
'* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, eMail, , , "Open Issues", _
"Your prompt action is required for the following issues!"
DoCmd.Close acReport, cboReports.Value
.MoveNext
Wend
End With
End If
ElseIf cboReports = "Issues By Assigned To" Then
With CurrentDb.OpenRecordset("SELECT DISTINCT [Assigned To] FROM [Issues]")
If Not (.BOF And .EOF) Then .MoveFirst
i = 0
While Not .EOF
i = i + 1
thisCriteria = strCriteria & " And [Assigned To]=" & Nz(.Fields(0).Value, 0)
eMail = DLookup("[E-mail Address]", "Contacts", "ID=" & Nz(.Fields(0).Value, 0))
'* close report if already open
If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
DoCmd.Close acReport, cboReports.Value
End If
thisCriteria = strCriteria & " AND "
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
'* this is a test
'* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, .Fields(0).Value, , , "Issues By Assigned To", _
"your message here"
DoCmd.Close acReport, cboReports.Value
.MoveNext
Wend
End With
Else
'* add Title and Message below
'*
Select Case cboReports.Value
Case Is = "Closed Issues"
'Title =
'Message =
Case Is = "Contact Address Book"
Case Is = "Contact Phone Book"
Case Is = "Issue Details"
Case Is = "Open Issues By Category"
Case Is = " Open Issues By Status"
End Select
With CurrentDb.OpenRecordset("SELECT DISTINCT [E-mail Address] FROM [Contacts];")
If Not (.BOF And .EOF) Then .MoveFirst
i = 0
While Not .EOF
i = i + 1
'* close report if already open
If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
DoCmd.Close acReport, cboReports.Value
End If
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
'* this is a test
'* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, .Fields(0).Value, , , Title, Message
DoCmd.Close acReport, cboReports.Value
.MoveNext
Wend
End With
End If
End Select
End If
End Sub
This code was kindly create for me. when I tested it, it seemed to work great
now I have added more contacts in the contact table I see it is not working correctly
what this does is prepare to send a report from the "open issues" to ALL the people in the contacts file who have a report "assigned to" them.
what i really need it to do is prepare to send an e-mail to the people who have "active" reports in the "open issues" and it is assigned to them
any help will be apricated
file attached , if yousee the assigned to field you will see 2 names .when you select the report " open issues assigned to " you will see it will send a report to all 3 people in the contacts list which is not correct
thanks steve
[CODEPrivate Sub cboReports_AfterUpdate()
Dim strCriteria As String
Dim thisCriteria As String
Dim eMail As String
Dim Title As String
Dim Message As String
Dim i As Integer
DoCmd.OpenForm FormName:="ReportDialog", WindowMode:=acDialog
'* check if [TextReportOption] <> 0
If Me.TextReportOption <> 0 Then
strCriteria = "(1=1)" '(1=1) means it is always True, therefore returns all records
Select Case Me.TextReportOption
Case Is = 1 'Print Preview
'* Open the report with criteria
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=strCriteria
Case Is = 2 'Print
'* Open the report with criteria
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewNormal, WHERECONDITION:=strCriteria
Case Is = 3 'Email report
If cboReports = "Open Issues" Then
strCriteria = "[STATUS]=""ACTIVE"""
If DCount("1", "Issues", "Status=""Active""") <> 0 Then
With CurrentDb.OpenRecordset("SELECT DISTINCT [Assigned To] FROM [Issues] " & _
"WHERE [Status]=""Active""")
If Not (.BOF And .EOF) Then .MoveFirst
i = 0
While Not .EOF
i = i + 1
thisCriteria = strCriteria & " And [Assigned To]=" & Nz(.Fields(0).Value, 0)
eMail = DLookup("[E-mail Address]", "Contacts", "ID=" & Nz(.Fields(0).Value, 0))
'* close report if already open
If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
DoCmd.Close acReport, cboReports.Value
End If
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
'* this is a test
'* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, eMail, , , "Open Issues", _
"Your prompt action is required for the following issues!"
DoCmd.Close acReport, cboReports.Value
.MoveNext
Wend
End With
End If
ElseIf cboReports = "Issues By Assigned To" Then
With CurrentDb.OpenRecordset("SELECT DISTINCT [Assigned To] FROM [Issues]")
If Not (.BOF And .EOF) Then .MoveFirst
i = 0
While Not .EOF
i = i + 1
thisCriteria = strCriteria & " And [Assigned To]=" & Nz(.Fields(0).Value, 0)
eMail = DLookup("[E-mail Address]", "Contacts", "ID=" & Nz(.Fields(0).Value, 0))
'* close report if already open
If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
DoCmd.Close acReport, cboReports.Value
End If
thisCriteria = strCriteria & " AND "
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
'* this is a test
'* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, .Fields(0).Value, , , "Issues By Assigned To", _
"your message here"
DoCmd.Close acReport, cboReports.Value
.MoveNext
Wend
End With
Else
'* add Title and Message below
'*
Select Case cboReports.Value
Case Is = "Closed Issues"
'Title =
'Message =
Case Is = "Contact Address Book"
Case Is = "Contact Phone Book"
Case Is = "Issue Details"
Case Is = "Open Issues By Category"
Case Is = " Open Issues By Status"
End Select
With CurrentDb.OpenRecordset("SELECT DISTINCT [E-mail Address] FROM [Contacts];")
If Not (.BOF And .EOF) Then .MoveFirst
i = 0
While Not .EOF
i = i + 1
'* close report if already open
If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
DoCmd.Close acReport, cboReports.Value
End If
DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WHERECONDITION:=thisCriteria
'* this is a test
'* DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, .Fields(0).Value, , , Title, Message
DoCmd.Close acReport, cboReports.Value
.MoveNext
Wend
End With
End If
End Select
End If
End Sub
Code:
Attachments
Last edited: