Multiselect listbox add table records - handling if 0

[misscrf]

I have a related thread here: thread702-1610544 . This has come a long way, so I thought it better to start a new thread.

I have an events form, where a user can create a new event. This lets them keep track of RSVPs and such.

There is a subform of invited contacts to an event. They can also click a button for Invite Contacts, which opens a pop-up form.

On this pop-up form there is an extended listbox of all the contacts. If they don't choose one, they get a msgbox saying they must pick at least one to add. Then they can choose to also give all invites being added to the event, a common invite date, rsvp date, and rsvp response.

Beyond this, there is a second extended listbox. This has the list of Account managers who might be inviting contacts to an event.

During initial setup, it was my understanding that contacts would always be invited by at least 1 acct man. but could be invited on behalf of (obo) more than 1.

Now I am finding out that the user needs to be able to use this form without choosing any acct man. I can't figure out how to set my code to just not add any sub records for the invited contact record that was just created, since no records are selected in the 2nd listbox.

This is my code:

Private Sub cmdAddClose_Click()
  Dim strSQL        As String
  Dim db            As DAO.Database
  Dim rs            As DAO.Recordset
  Dim ctl           As Control
  Dim ctl2          As Control
  Dim varItem       As Variant
  Dim varitemobo    As Variant
  Dim holdID        As Long
  Dim ID 'Dim the ID variable

  On Error GoTo ErrorHandler

  Set db = CurrentDb()
  Set rs = db.OpenRecordset("tblEventInvite", dbOpenDynaset, dbSeeChanges)

  'make sure a selection has been made
        If Me.lstInviteContact.ItemsSelected.Count = 0 Then
    MsgBox "Must select at least 1 contact to invite;-)"
        Exit Sub
            End If

  
  'add selected value(s) to table
        Set ctl = Me.lstInviteContact
        
        For Each varItem In ctl.ItemsSelected
    rs.AddNew
    rs!FKEvent = [Forms]![frmEvent].PKEventID
    rs!FKContact = ctl.ItemData(varItem)
    
        If Me.dtInviteSent.Value <> "" Then
    rs!dtInviteSent = Me.dtInviteSent
        End If
    
        If Me.dtRSVPReceived.Value <> "" Then
    rs!dtRSVPReceived = Me.dtRSVPReceived
        End If
    
        If Me.intPlusGuest.Value <> "" Then
    rs!intPlusGuest = Me.intPlusGuest
        End If
    
        If Me.FKRSVP.Value <> "" Then
    rs!FKRSVP = Me.FKRSVP
        End If
    
        If Me.MemEventInvNotes.Value <> "" Then
    rs!MemEventInvNotes = Me.MemEventInvNotes
        End If
    
    rs.Update
    
    rs.Bookmark = rs.LastModified

    Set rs2 = db.OpenRecordset("tblEventInvOBO", dbOpenDynaset, dbSeeChanges)
    
    If Me.lstAcctManOBO.ItemsSelected.Count = 0 Then
    MsgBox "Must select at least 1 AcctMan to assign as sending on behalf of. ;-)"
        Exit Sub
            End If

Set ctl2 = Me.lstAcctManOBO
        For Each varitemobo In ctl2.ItemsSelected
    rs2.AddNew
    rs2!FKEventInvite = rs!PKEventInviteID
    rs2!FKAcctMan = ctl2.ItemData(varitemobo)
    'rs2!FKAcctMan = ctl2.ItemData(ctl2.ItemsSelected(varitemobo))
    
    
        If Not IsNull(Me.MemOBONotes.Value) Then
    rs2!memEventInvOBO = Me.MemOBONotes
        End If

    rs2.Update
   
    Next varitemobo
    Next varItem

    Forms!frmEvent!frmSubEventInvite.Requery
    Forms!frmEvent!frmSubEventInvite.Form!txtCurrRec.Requery
    Forms!frmEvent.Visible = True

    DoCmd.Close acForm, "frmInviteContact", acSaveNo

ExitHandler:
  Set rs = Nothing
  Set rs2 = Nothing
  Set db = Nothing
  Exit Sub

ErrorHandler:
  Select Case Err
    Case Else
      MsgBox Err.Description
      DoCmd.Hourglass False
      Resume ExitHandler
  End Select

End Sub

This part is where I start to evaluate the 2nd listbox:

   Set rs2 = db.OpenRecordset("tblEventInvOBO", dbOpenDynaset, dbSeeChanges)
    
    If Me.lstAcctManOBO.ItemsSelected.Count = 0 Then
    MsgBox "Must select at least 1 AcctMan to assign as sending on behalf of. ;-)"
        Exit Sub
            End If

Set ctl2 = Me.lstAcctManOBO
        For Each varitemobo In ctl2.ItemsSelected
    rs2.AddNew
    rs2!FKEventInvite = rs!PKEventInviteID
    rs2!FKAcctMan = ctl2.ItemData(varitemobo)
    'rs2!FKAcctMan = ctl2.ItemData(ctl2.ItemsSelected(varitemobo))
    
    
        If Not IsNull(Me.MemOBONotes.Value) Then
    rs2!memEventInvOBO = Me.MemOBONotes
        End If

    rs2.Update
   
    Next varitemobo
    Next varItem

I tried a couple of things to comment out the msgbox and just put something like ct12 = nothing, but that doesn't work. I keep getting object variable without block variable.

Can anyone please help?

Thanks!

misscrf

It is never too late to become what you could have been ~ George Eliot

 

[misscrf]

nevermind, I got this figured out. Following code:

Set rs2 = db.OpenRecordset("tblEventInvOBO", dbOpenDynaset, dbSeeChanges)
    
    If Me.lstAcctManOBO.ItemsSelected.Count > 0 Then
   
Set ctl2 = Me.lstAcctManOBO
        For Each varitemobo In ctl2.ItemsSelected
    rs2.AddNew
    rs2!FKEventInvite = rs!PKEventInviteID
    rs2!FKAcctMan = ctl2.ItemData(varitemobo)
    'rs2!FKAcctMan = ctl2.ItemData(ctl2.ItemsSelected(varitemobo))
    
    
        If Not IsNull(Me.MemOBONotes.Value) Then
    rs2!memEventInvOBO = Me.MemOBONotes
        End If

    rs2.Update
   
    Next varitemobo
end if
    Next varItem

misscrf

It is never too late to become what you could have been ~ George Eliot