D
Dan @BCBS
Very strange..
When I run the below code and review the report it returns exactally what I
need.
For example, if I run it asking for one "reviewer".
(DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria)
But when I add the code to send the results email, the file created and
ready to send has all reviewers.
(DoCmd.SendObject acReport, stDocName, acFormatRTF, , , , , , True)
Why can I not send the results?????
Private Sub cmdKeyIndicators_Click()
On Error GoTo Err_cmdKeyIndicators_Click
Dim stDocName As String
'these need to be declared also
Dim stAreaList As String
Dim stProductList As String
Dim stReviewerList As String
Dim stLinkCriteria As String
'first time thru loop?
Dim FirstTime As Boolean
Dim stArea As Variant
Dim stProduct As Variant
Dim stReviewer As Variant
stDocName = "r_KeyIndicators"
stAreaList = ""
stProductList = ""
stReviewerList = ""
'dates
If IsNull(txtStart) Or IsNull(txtEnd) Then
MsgBox "Please enter start and end dates"
Exit Sub
End If
'get areas selected in ListArea
FirstTime = True
For Each stArea In ListArea.ItemsSelected
If FirstTime Then
stAreaList = "In('" & ListArea.ItemData(stArea) & "'"
FirstTime = False
Else
stAreaList = stAreaList & ",'" & ListArea.ItemData(stArea) & "'"
End If
Next stArea
If Not FirstTime Then
stAreaList = stAreaList & ")"
End If
'get products in ListProduct
FirstTime = True
For Each stProduct In ListProduct.ItemsSelected
If FirstTime Then
stProductList = "In('" & ListProduct.ItemData(stProduct) & "'"
FirstTime = False
Else
stProductList = stProductList & ",'" & ListProduct.ItemData(stProduct) & "'"
End If
Next stProduct
If Not FirstTime Then
stProductList = stProductList & ")"
End If
'get reviewer in ListReviewer
FirstTime = True
For Each stReviewer In ListReviewer.ItemsSelected
If FirstTime Then
stReviewerList = "In('" & ListReviewer.ItemData(stReviewer) & "'"
FirstTime = False
Else
stReviewerList = stReviewerList & ",'" & ListReviewer.ItemData(stReviewer) &
"'"
End If
Next stReviewer
If Not FirstTime Then
stReviewerList = stReviewerList & ")"
End If
'create criteria string
'stAreaList
If Len(Trim(Nz(stAreaList, ""))) > 0 Then
stLinkCriteria = "[gbulocation] " & stAreaList & " And "
End If
'stProductList
If Len(Trim(Nz(stProductList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[insurancetype] " & stProductList & " And "
End If
'stReviewerList
If Len(Trim(Nz(stReviewerList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[Reviewer] " & stReviewerList & " And """
End If
'now remove the last 'And' and spaces
stLinkCriteria = Left(stLinkCriteria, Len(stLinkCriteria) - 5)
'-------------------------
' for debugging - delete after code runs without errors
' MsgBox stLinkCriteria
'-------------------------
'open report in preview mode
'DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria
DoCmd.SendObject acReport, stDocName, acFormatRTF, , , , , , True
Exit_cmdKeyIndicators:
Exit Sub
Err_cmdKeyIndicators_Click:
Err_cmdKeyIndicators:
MsgBox err.Description
Resume Exit_cmdKeyIndicators
End Sub
When I run the below code and review the report it returns exactally what I
need.
For example, if I run it asking for one "reviewer".
(DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria)
But when I add the code to send the results email, the file created and
ready to send has all reviewers.
(DoCmd.SendObject acReport, stDocName, acFormatRTF, , , , , , True)
Why can I not send the results?????
Private Sub cmdKeyIndicators_Click()
On Error GoTo Err_cmdKeyIndicators_Click
Dim stDocName As String
'these need to be declared also
Dim stAreaList As String
Dim stProductList As String
Dim stReviewerList As String
Dim stLinkCriteria As String
'first time thru loop?
Dim FirstTime As Boolean
Dim stArea As Variant
Dim stProduct As Variant
Dim stReviewer As Variant
stDocName = "r_KeyIndicators"
stAreaList = ""
stProductList = ""
stReviewerList = ""
'dates
If IsNull(txtStart) Or IsNull(txtEnd) Then
MsgBox "Please enter start and end dates"
Exit Sub
End If
'get areas selected in ListArea
FirstTime = True
For Each stArea In ListArea.ItemsSelected
If FirstTime Then
stAreaList = "In('" & ListArea.ItemData(stArea) & "'"
FirstTime = False
Else
stAreaList = stAreaList & ",'" & ListArea.ItemData(stArea) & "'"
End If
Next stArea
If Not FirstTime Then
stAreaList = stAreaList & ")"
End If
'get products in ListProduct
FirstTime = True
For Each stProduct In ListProduct.ItemsSelected
If FirstTime Then
stProductList = "In('" & ListProduct.ItemData(stProduct) & "'"
FirstTime = False
Else
stProductList = stProductList & ",'" & ListProduct.ItemData(stProduct) & "'"
End If
Next stProduct
If Not FirstTime Then
stProductList = stProductList & ")"
End If
'get reviewer in ListReviewer
FirstTime = True
For Each stReviewer In ListReviewer.ItemsSelected
If FirstTime Then
stReviewerList = "In('" & ListReviewer.ItemData(stReviewer) & "'"
FirstTime = False
Else
stReviewerList = stReviewerList & ",'" & ListReviewer.ItemData(stReviewer) &
"'"
End If
Next stReviewer
If Not FirstTime Then
stReviewerList = stReviewerList & ")"
End If
'create criteria string
'stAreaList
If Len(Trim(Nz(stAreaList, ""))) > 0 Then
stLinkCriteria = "[gbulocation] " & stAreaList & " And "
End If
'stProductList
If Len(Trim(Nz(stProductList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[insurancetype] " & stProductList & " And "
End If
'stReviewerList
If Len(Trim(Nz(stReviewerList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[Reviewer] " & stReviewerList & " And """
End If
'now remove the last 'And' and spaces
stLinkCriteria = Left(stLinkCriteria, Len(stLinkCriteria) - 5)
'-------------------------
' for debugging - delete after code runs without errors
' MsgBox stLinkCriteria
'-------------------------
'open report in preview mode
'DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria
DoCmd.SendObject acReport, stDocName, acFormatRTF, , , , , , True
Exit_cmdKeyIndicators:
Exit Sub
Err_cmdKeyIndicators_Click:
Err_cmdKeyIndicators:
MsgBox err.Description
Resume Exit_cmdKeyIndicators
End Sub