Multiselect to append

[lmv]

I have records in the product table that I want to use to append records to
orders detail table. I have a multiselect form that I "found" which is very
nice.

It allows sending the cked records to a report to view on the fly... is it
possible to do append to another table the same way with another cmdButton?
If so how would you write the code...

Thanks!
lmv

Below is all the code...

Option Compare Database
Option Explicit
Dim colCheckBox As New Collection

Public Function IsChecked(vID As Variant) As Boolean

Dim lngID As Long
IsChecked = False
On Error GoTo exit1
lngID = colCheckBox(CStr(vID))
If lngID <> 0 Then
IsChecked = True
End If
exit1:
End Function


Private Sub Check11_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeySpace Then
KeyCode = 0
Call Command13_Click
End If
End Sub

Private Sub Command13_Click()
'Debug.Print "Product = " & Me.ProductID

If IsChecked(Me.ProductID) = False Then
colCheckBox.Add CLng(Me.ProductID), CStr(Me.ProductID)
Else
colCheckBox.Remove (CStr(Me.ProductID))
End If
Me.Check11.Requery

End Sub

Private Sub Command14_Click()

MsgBox "records selected = " & MySelected, vbInformation, "Multi Select
example"

End Sub

Private Function MySelected() As String


Dim I As Integer

For I = 1 To colCheckBox.Count
If MySelected <> "" Then
MySelected = MySelected & ","
End If
MySelected = MySelected & colCheckBox(I)

Next I


End Function



Private Sub Command16_Click()

Dim strWhere As String

strWhere = MySelected

If strWhere <> "" Then

strWhere = "ProductID in (" & strWhere & ")"

End If

DoCmd.OpenReport "rptOrders", acViewPreview, , strWhere
DoCmd.RunCommand acCmdZoom100 ' this is optional


End Sub

Private Sub Command17_Click()

Set colCheckBox = Nothing
Me.Requery


End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

' key hand

Select Case KeyCode

Case vbKeyUp
KeyCode = 0
On Error Resume Next
DoCmd.GoToRecord acActiveDataObject, , acPrevious

Case vbKeyDown
KeyCode = 0
On Error Resume Next
DoCmd.GoToRecord acActiveDataObject, , acNext

' Case vbKeyReturn
' If IsNull(Me.ID) = False Then
' KeyCode = 0
' Call EditMain
' End If

End Select

End Sub

Private Sub Form_Load()
Me.ProductName.SetFocus

End Sub

Private Sub ProductName_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub


Private Function ChangeOrderBy(strFieldName As String) As Boolean

Dim strActiveCtlName As String
Dim strOrderby As String
strOrderby = Me.OrderBy
strActiveCtlName = Screen.ActiveControl.name
If Me.OrderBy = strFieldName Then
Me.OrderBy = strFieldName & " Desc"
Else
Me.OrderBy = strFieldName
End If
Me.OrderByOn = True
ChangeOrderBy = True
End Function

 

[John Vinson]

I have records in the product table that I want to use to append records to
orders detail table. I have a multiselect form that I "found" which is very
nice.

It allows sending the cked records to a report to view on the fly... is it
possible to do append to another table the same way with another cmdButton?
If so how would you write the code...

Here's some code I use in one of my apps; if you need help adapting it
post back in a new thread (I'm leaving for a week pretty shortly and
may not be able to follow up):

Private Sub cmdProcess_Click()
' Comments : Update the AnimalCondition table based on
' the selections in
' the unbound multiselect listbox lstHealthIssues.
' Newly selected rows will be added to the table,
' newly cleared
' rows will be deleted.
' Parameters: None
' Modified : 01/29/02 by JWV
'
' --------------------------------------------------
' Populate the AnimalCondition table with the selected issues
On Error GoTo PROC_ERR

Dim iItem As Integer
Dim lngCondition As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset

' save the current record if it's not saved
If Me.Dirty = True Then
Me.Dirty = False
End If
Set db = CurrentDb
' Open a Recordset based on the table
Set rs = db.OpenRecordset("AnimalCondition", dbOpenDynaset)
With Me!lstHealthIssues
' Loop through all rows in the Listbox
For iItem = 0 To .ListCount - 1
lngCondition = .Column(0, iItem)
' Determine whether this AnimalID-HealthID combination is
' in the table
rs.FindFirst "[AnimalID] = " & Me.AnimalID & " AND " _
& "[HealthIssueID] = " & lngCondition
If rs.NoMatch Then ' this item has not been added
If .Selected(iItem) Then
' add it
rs.AddNew
rs!AnimalID = Me.AnimalID
rs!HealthIssueID = lngCondition
rs.Update
End If ' if it wasn't selected, ignore it
Else
If Not .Selected(iItem) Then
' delete this record if it's been deselected
rs.Delete
End If ' if it was selected, leave it alone
End If
Next iItem
End With
rs.Close
Set rs = Nothing
Set db = Nothing
Me.subAnimalCondition.Requery

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox "Error " & Err.Number & " in cmdProcess_Click:" _
& vbCrLf & Err.Description
Resume PROC_EXIT

End Sub



John W. Vinson[MVP]