[AccessD] Force selection of multiple records on a datasheet subform

Bill Benson bensonforums at gmail.com
Wed Jun 10 09:53:21 CDT 2015


I think my last post was too long for the list, here it is again just in
case.

Subform code:

Option Compare Database
Option Explicit
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
EstablishSelections
End Sub
Private Sub EstablishSelections()
Dim iHeight As Long
Dim i As Long
Dim sIDString As String
Dim rS As DAO.Recordset
iHeight = Me.SelHeight
On Error Resume Next
If iHeight > 0 Then
    ReDim ArSubformSelections(1 To 4, 1 To iHeight)
    sIDString = ""
    Set rS = Me.RecordsetClone
    rS.MoveFirst
    rS.Move Me.SelTop - 1
Else
    Exit Sub
End If
For i = 1 To iHeight
    ArSubformSelections(1, i) = rS![ID]
    ArSubformSelections(2, i) = rS![EmployeeName]
    ArSubformSelections(3, i) = rS![EmployeeFirstName]
    ArSubformSelections(4, i) = rS![Email]
    sIDString = sIDString & "," & ArSubformSelections(1, i)
    rS.MoveNext
Next
If sIDString <> "" Then
    sIDString = "(" & Mid(sIDString, 2) & ")"
End If
End Sub

Parent form Code:

Private Sub cmdSendSelected_Click()
Dim iTest As Long
Dim i As Long, iCount As Long, iFirstSelection As Long, iLastSelection As
Long
Dim rst As DAO.Recordset
Dim FRM As Form
Dim F As Form
On Error Resume Next
iTest = UBound(ArSubformSelections, 2)
On Error GoTo 0
If iTest > 0 Then
    For iTest = 1 To UBound(ArSubformSelections, 2)
        If Err.Number = 0 Then
            If Len(CStr(ArSubformSelections(2, iTest))) > 0 Then
                iCount = iCount + 1
                If iCount = 1 Then
                    iFirstSelection = ArSubformSelections(1, iTest)
                End If
                iLastSelection = iTest
            End If
        End If
    Next

    If iFirstSelection > 0 Then
        Set F = Me.rptFinishedReportsNotYetSent.Form
        Set rst = F.RecordsetClone
        rst.FindFirst "Id = " & iFirstSelection
        If Not rst.NoMatch Then
            F.Bookmark = rst.Bookmark
            F.SelHeight = iCount
        End If

        If iLastSelection > iLastSelection Then
            If MsgBox("Send reports for IDs " & ArSubformSelections(1,
iFirstSelection) & " through " & ArSubformSelections(1, iLastSelection) &
"?", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
                'Get details of items to send from the array
            End If
        Else
            If MsgBox("Send reports to " & ArSubformSelections(1,
iFirstSelection) & "?", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes
Then
                'Get details of items to send from the array
            End If
        End If
    End If
End If
End Sub

Public variable declaration
Public ArSubformSelections()


More information about the AccessD mailing list