Where Condition (OpenReport)

[szag via AccessMonster.com]

I am struglling with the Where condition when I use OpenReport. In a form I
have a list box in which I can choose multiple selections. Then in my report
I want to the "email" field to equal the current list box selection (I have
it loop through each selection). Will it work with a mutiple selection list
box? I know the code below is wrong but I am looking for help on how to state
the where condition:

DoCmd.OpenReport "1", acViewPreview, , " = " & Nz(lst.Column(1,
varItem))

Thanks!

 

[krissco]

Here is a function that I use for this purpose. Feel free to modify
the code as you desire.

Add this function to your report module and change your code to this:

DoCmd.OpenReport "1", acViewPreview, , " = in" &
getSelectedList(Me.lst)

'Returns a list of selected rows from a list box control. This list
will be evaluated by an "in" clause
Private Function getSelectedList(ctl As Control) As String
Dim currentRow As Integer
'Traverse through each code in the list to see if it is selected.
getSelectedList = "("
If ctl.ItemsSelected.Count > 0 Then
For currentRow = 0 To ctl.ListCount - 1
If ctl.Selected(currentRow) Then
If getSelectedList <> "(" Then getSelectedList =
getSelectedList & ", "
getSelectedList = getSelectedList & "'" &
ctl.Column(0, currentRow) & "'"
End If
Next currentRow
getSelectedList = getSelectedList & ")"
Else
getSelectedList = vbNullString
End If
End Function

-Kris

 

[szag via AccessMonster.com]

Kris - thanks alot! As I said I am a real newbie to VBA. Not sure how I
insert your code (and take away what shouldn't be there) into my code below.
Would you be able to help


Set lst = Me![lstSelectContacts]
'Check that at least one contact has been selected
If lst.ItemsSelected.Count = 0 Then
MsgBox "Please select at least one contact"
lst.SetFocus
GoTo ErrorHandlerExit
End If


For Each varItem In lst.ItemsSelected
'Check for email address
strEMailRecipient = Nz(lst.Column(1, varItem))
Debug.Print "EMail address: " & strEMailRecipient
If strEMailRecipient = "" Then
GoTo NextContact
End If

DoCmd.OpenReport "1", acViewPreview

Set rpt = Reports("1")
'---------- set report filter and turn it on
rpt.FilterOn = True
'rpt.FilterOn = IIf(Len(pFilter) > 0, True, False)
'---------- save and close the changed report
DoCmd.Save acReport, "1"
DoCmd.Close acReport, "1"
DoCmd.SendObject acReport, 1, _
OutputFormat:=acFormatRTF, To:=strEMailRecipient, _
Subject:=strSubject, EditMessage:=False

NextContact:
Next varItem

ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit

End Sub

Here is a function that I use for this purpose. Feel free to modify
the code as you desire.

Add this function to your report module and change your code to this:

DoCmd.OpenReport "1", acViewPreview, , " = in" &
getSelectedList(Me.lst)

'Returns a list of selected rows from a list box control. This list
will be evaluated by an "in" clause
Private Function getSelectedList(ctl As Control) As String
Dim currentRow As Integer
'Traverse through each code in the list to see if it is selected.
getSelectedList = "("
If ctl.ItemsSelected.Count > 0 Then
For currentRow = 0 To ctl.ListCount - 1
If ctl.Selected(currentRow) Then
If getSelectedList <> "(" Then getSelectedList =
getSelectedList & ", "
getSelectedList = getSelectedList & "'" &
ctl.Column(0, currentRow) & "'"
End If
Next currentRow
getSelectedList = getSelectedList & ")"
Else
getSelectedList = vbNullString
End If
End Function

-Kris[/QUOTE]

 

[Guest]

This fuction is built to do exactly what you are trying to do:

Public Function BuildWhereCondition(ctl As Control) As String
'Set up the WhereCondition Argument for the reports
Dim varItem As Variant
Dim strWhere As String

On Error GoTo BuildWhereCondition_Error

Select Case ctl.ItemsSelected.Count
Case 0 'Include All
strWhere = ""
Case 1 'Only One Selected
strWhere = "= '" & _
ctl.ItemData(ctl.ItemsSelected(0)) & "'"
Case Else 'Multiple Selection
strWhere = " IN ("

With ctl
For Each varItem In .ItemsSelected
strWhere = strWhere & "'" & .ItemData(varItem) & "', "
Next varItem
End With
strWhere = Left(strWhere, Len(strWhere) - 2) & ")"
End Select

BuildWhereCondition = strWhere

BuildWhereCondition_Exit:
On Error GoTo 0

Exit Function

BuildWhereCondition_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure BuildWhereCondition of Module modUtilities"
GoTo BuildWhereCondition_Exit

End Function

Call it with the control and it will create the right side of the Where
condition. You just have to add the object you want to compare to:

strWhere = BuildWhereCondition(me.lstBox)
DoCmd.OpenReport "1", acViewPreview, , " = " & strWhere

 

[krissco]

Sorry, I thought you were asking for something else.

What your code is trying to do is to modify the report and save the
filter prior to sending an email. I'm not too familiar with saving a
filter within a report and don't know if this approach will work.

What is your e-mail program? If you are using Outlook, I'll give you
the code I use to:

1. Loop through a list of recipients
2. Export a filtered report
3. Create and send an outlook message with the exported file as an
attachment

I don't mess with trying to save the filter as all my databases are
multi-user.

-Kris

 

[szag via AccessMonster.com]

Yes - I am using outlook.

Sorry, I thought you were asking for something else.

What your code is trying to do is to modify the report and save the
filter prior to sending an email. I'm not too familiar with saving a
filter within a report and don't know if this approach will work.

What is your e-mail program? If you are using Outlook, I'll give you
the code I use to:

1. Loop through a list of recipients
2. Export a filtered report
3. Create and send an outlook message with the exported file as an
attachment

I don't mess with trying to save the filter as all my databases are
multi-user.

-Kris

 

[krissco]

Ok then. This is a long one:

'The calling function will be different depending on your application
'It will look something like this
'Place this in a standard module and modify it for your application.
You may want to add a parameter for the report.
public function EmailReportHelper()

'Setup
Dim rst as new adodb.recordset
Dim strSql as string
strSql = "select vendor, email " _
& "from vendorContact "

'Fetch
rst.open strsql, currentproject.connection, adopenforwardonly,
adlockreadonly

'Iterate through vendors - call the email function for each separate
criteria desired
'The "DoEvents" may not be necessary - I like having it for good
measure.
while not rst.eof
emailreport "Your Report Name", "Vendor = '" & rst(0) & "'", rst(1)
doevents
rst.movenext
wend

'Cleanup
if not rst is nothing then
if rst.state = adstateopen then rst.close
set rst = nothing
end if
end function



'Use with a report that has a filter-examining output criteria (see
later)
'Place this in a standard module. You will probably need to add a
reference to the
'Outlook Object Library. You can also modify this code to use late
binding and get around having to
'set the reference.
Public Function emailReport(strReportName As String, _
strFilter As String, _
Optional strTo As String, _
Optional strSubject As String) As Boolean

On Error GoTo emailReport_Err

'Declarations
Dim objOutlook As Outlook.Application, objOutlookMsg As
Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient, objOutlookAttach As
Outlook.Attachment

'Delete old outputfile
deleteEmailFile

'Open report - must be one that examines the Email = Email filter to
output to the getEmailFile() path
'Why do I do this? Seems strange to express TRUE as 'Email' = 'Email'
- this allows me to use the same report
'in multiple areas. In my application, the user selects the type of
output (preview, print, email, fax, etc.)
DoCmd.OpenReport strReportName, acViewPreview, , "'Email' = 'Email'" &
iif(strFilter <> "", " and ", "") & strFilter
DoCmd.Close acReport, strReportName, False

'Email file has been created, now create the outlook file

' Create the Outlook session and message
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg

' Add the To recipients to the e-mail message.
If strTo <> vbNullString Then
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = olTo
End If

' Set the Subject, the Body, and the Importance of the e-mail
message.
.Subject = strSubject
.Body = "See Attached."
.Importance = olImportanceNormal

'Attach the report to the e-mail message.
Set objOutlookAttach = .Attachments.Add(getEmailFile())

' Resolve the name of each Recipient.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

'Display the message
.Display

End With

emailReport = True

emailReport_Exit:
On Error Resume Next
deleteEmailFile
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Exit Function

emailReport_Err:
emailReport = False
Select Case Err.number
Case -2079129595 'Insufficient privilage - Outlook is not open
MsgBox "You must have Outlook open to send this email.",
vbExclamation, "Outlook Is Not Open"
Resume emailReport_Exit
Case 287 'User canceled send
Resume emailReport_Exit
Case Else
logError Err.number, "emailReport", "Report: " &
strReportName & " Filter: " & strFilter
MsgBox "Unhandled error #" & Err.number & vbCrLf &
Err.Description, vbCritical, "ERROR"
Resume emailReport_Exit
End Select

End Function


'This goes in the report module.
'If opening with the view set as email, the filter will
'contain True as expressed by 'Email' = 'Email'. This is an indicator
'that the report must be exported as a snapshot file to the
'getEmailFile() location. The static variable ensures no duplicates
when pages are reformatted.
Private Sub Report_Page()
If Me.Filter Like "*'Email' = 'Email'*" Then
Static PRINTED As Boolean
If PRINTED = False Then
PRINTED = True
DoCmd.OutputTo acOutputReport, , acFormatSNP, getEmailFile(),
False
End If
End If
End Sub

'These last two helper functions are useful, but not required. I
always export email files to the same location.
Public Function getEmailFile() As String
getEmailFile = CurrentProject.Path & "\EmailOutputFile.snp"
End Function

Public Sub deleteEmailFile()
On Error Resume Next
If Dir(getEmailFile()) <> vbNullString Then Kill getEmailFile()
End Sub



Have fun with that one!

-Kris

 

[szag via AccessMonster.com]

Thanks! -Steve

Ok then. This is a long one:

'The calling function will be different depending on your application
'It will look something like this
'Place this in a standard module and modify it for your application.
You may want to add a parameter for the report.
public function EmailReportHelper()

'Setup
Dim rst as new adodb.recordset
Dim strSql as string
strSql = "select vendor, email " _
& "from vendorContact "

'Fetch
rst.open strsql, currentproject.connection, adopenforwardonly,
adlockreadonly

'Iterate through vendors - call the email function for each separate
criteria desired
'The "DoEvents" may not be necessary - I like having it for good
measure.
while not rst.eof
emailreport "Your Report Name", "Vendor = '" & rst(0) & "'", rst(1)
doevents
rst.movenext
wend

'Cleanup
if not rst is nothing then
if rst.state = adstateopen then rst.close
set rst = nothing
end if
end function

'Use with a report that has a filter-examining output criteria (see
later)
'Place this in a standard module. You will probably need to add a
reference to the
'Outlook Object Library. You can also modify this code to use late
binding and get around having to
'set the reference.
Public Function emailReport(strReportName As String, _
strFilter As String, _
Optional strTo As String, _
Optional strSubject As String) As Boolean

On Error GoTo emailReport_Err

'Declarations
Dim objOutlook As Outlook.Application, objOutlookMsg As
Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient, objOutlookAttach As
Outlook.Attachment

'Delete old outputfile
deleteEmailFile

'Open report - must be one that examines the Email = Email filter to
output to the getEmailFile() path
'Why do I do this? Seems strange to express TRUE as 'Email' = 'Email'
- this allows me to use the same report
'in multiple areas. In my application, the user selects the type of
output (preview, print, email, fax, etc.)
DoCmd.OpenReport strReportName, acViewPreview, , "'Email' = 'Email'" &
iif(strFilter <> "", " and ", "") & strFilter
DoCmd.Close acReport, strReportName, False

'Email file has been created, now create the outlook file

' Create the Outlook session and message
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg

' Add the To recipients to the e-mail message.
If strTo <> vbNullString Then
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = olTo
End If

' Set the Subject, the Body, and the Importance of the e-mail
message.
.Subject = strSubject
.Body = "See Attached."
.Importance = olImportanceNormal

'Attach the report to the e-mail message.
Set objOutlookAttach = .Attachments.Add(getEmailFile())

' Resolve the name of each Recipient.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

'Display the message
.Display

End With

emailReport = True

emailReport_Exit:
On Error Resume Next
deleteEmailFile
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Exit Function

emailReport_Err:
emailReport = False
Select Case Err.number
Case -2079129595 'Insufficient privilage - Outlook is not open
MsgBox "You must have Outlook open to send this email.",
vbExclamation, "Outlook Is Not Open"
Resume emailReport_Exit
Case 287 'User canceled send
Resume emailReport_Exit
Case Else
logError Err.number, "emailReport", "Report: " &
strReportName & " Filter: " & strFilter
MsgBox "Unhandled error #" & Err.number & vbCrLf &
Err.Description, vbCritical, "ERROR"
Resume emailReport_Exit
End Select

End Function

'This goes in the report module.
'If opening with the view set as email, the filter will
'contain True as expressed by 'Email' = 'Email'. This is an indicator
'that the report must be exported as a snapshot file to the
'getEmailFile() location. The static variable ensures no duplicates
when pages are reformatted.
Private Sub Report_Page()
If Me.Filter Like "*'Email' = 'Email'*" Then
Static PRINTED As Boolean
If PRINTED = False Then
PRINTED = True
DoCmd.OutputTo acOutputReport, , acFormatSNP, getEmailFile(),
False
End If
End If
End Sub

'These last two helper functions are useful, but not required. I
always export email files to the same location.
Public Function getEmailFile() As String
getEmailFile = CurrentProject.Path & "\EmailOutputFile.snp"
End Function

Public Sub deleteEmailFile()
On Error Resume Next
If Dir(getEmailFile()) <> vbNullString Then Kill getEmailFile()
End Sub

Have fun with that one!

-Kris