My problem is with two different multiselect listboxes
users should select multiple items from both and i want all related records to be shown
for lack of a "better" way i have created this code:
- On Error GoTo Trap
-
Dim msg As String, HolCom As String, SID As String, row As Variant, row2 As Variant
-
Dim tdef As TableDef, mySQL As String
-
If IsNull(Me.cDept) Then msg = msg & " - Department" & vbCrLf
-
If IsNull(Me.txtDateFrom) Then msg = msg & " - Date From" & vbCrLf
-
If IsNull(Me.txtDateTo) Then msg = msg & " - Date To" & vbCrLf
-
If Me.lHolCom.ItemsSelected.count = 0 Then msg = msg & " - Leave Comment/s" & vbCrLf
-
If Me.lStaff.ItemsSelected.count = 0 Then msg = msg & " - Staff Members/s" & vbCrLf
-
If Not msg = "" Then MsgBox "Please Complete the following fields..." & vbCrLf & msg, vbCritical, "Some Details Missing..." Else GoTo Main:
-
Exit Sub
-
-
Main:
-
Set tdef = CurrentDb.CreateTableDef(LogStaffID & "tblReports")
-
With tdef
-
.Fields.Append .CreateField("Name", dbText)
-
.Fields.Append .CreateField("Date", dbDate)
-
.Fields.Append .CreateField("AM", dbInteger)
-
.Fields.Append .CreateField("PM", dbInteger)
-
.Fields.Append .CreateField("MinsUsed", dbInteger)
-
.Fields.Append .CreateField("Comments", dbText)
-
CurrentDb.TableDefs.Append tdef
-
End With
-
DoCmd.SetWarnings False
-
For Each row In Me.lHolCom.ItemsSelected
-
For Each row2 In Me.lStaff.ItemsSelected
-
DoCmd.RunSQL "INSERT INTO [" & LogStaffID & "tblReports] ( Name, [Date], AM, PM, MinsUsed, Comments ) SELECT [Surname] & ', ' & [Forename] AS Name, tbl_Holidays.Date, tbl_Holidays.AM, tbl_Holidays.PM, IIf([UseMins]=True,[MinutesUsed],0) AS MinsUsed, tbl_Holidays.Comments FROM tblStaff INNER JOIN tbl_Holidays ON tblStaff.StaffID = tbl_Holidays.StaffID WHERE (((tbl_Holidays.Date) Between " & Me.txtDateFrom & " And " & Me.txtDateTo & ") AND ((tbl_Holidays.Comments)='" & Me.lHolCom.ItemData(row) & "') AND ((tbl_Holidays.StaffID)=" & Me.lStaff.ItemData(row2) & ") AND ((tbl_Holidays.AuthBY) Is Not Null) AND ((tbl_Holidays.CancBY) Is Null)) ORDER BY tblStaff.Surname;"
-
Next
-
Next
-
DoCmd.SetWarnings True
-
DoCmd.OpenReport "rptReports", acViewDesign
-
[Reports]![rptReports].RecordSource = LogStaffID & "tblReports"
-
[Reports]![rptReports]![Label12].Caption = "Staff Leave Reports " & Me.txtDateFrom & " " & Me.txtDateTo
-
DoCmd.OpenReport "rptReports", acViewPreview
-
Exit Sub
-
Trap:
-
Select Case Err.Number
-
Case 3010
-
DoCmd.DeleteObject acTable, LogStaffID & "tblReports"
-
Resume
-
Case Else
-
MsgBox Err.Number & " " & Err.Description
-
End Select
-
Any "easier" solutions welcome