Results 1 to 3 of 3
  1. #1
    nogames627 is offline Novice
    Windows 7 64bit Access 2010 64bit
    Join Date
    Nov 2013
    Posts
    6

    (Run Time Error 91). I am trying to update a jeopardy game for military training.

    I am trying to edit a template I found on utteraccess to make a military training game and when I initialize the board set up I am getting a Run Time Error 91 (Object Variable or With Variable not set) on the Call jsn.Initialize_Session(Me, "New") line. Can anyone offer me ideas as to why. I am new to VBA and anyhelp is greatly appreciated.




    Private Sub cmdNewPlay_Click()
    Dim ctl As Control
    Dim bValidTeams As Boolean
    Dim i As Integer
    Dim iSessionID As Integer
    Dim sMessage As String
    Dim sSQL1 As String
    Dim sSQL2 As String
    [Call jsn.Initialize_Session(Me, "New")]

    'Validate requirements for a new game to be completed.
    'Team Population
    Select Case gtCurrentGame.TeamCount
    Case 1
    GoSub ValidTeam1
    Case 2
    GoSub ValidTeam1
    GoSub ValidTeam2
    Case 3
    GoSub ValidTeam1
    GoSub ValidTeam2
    GoSub ValidTeam3
    End Select
    GoTo valid_start
    ValidTeam1:
    If Me.lstPersonnelTeam1.ListCount > 0 Then
    bValidTeams = True
    Else
    bValidTeams = False
    GoTo false_start
    End If
    Return
    ValidTeam2:
    If Me.lstPersonnelTeam2.ListCount > 0 Then
    bValidTeams = True
    Else
    bValidTeams = False
    GoTo false_start
    End If
    Return
    ValidTeam3:
    If Me.lstPersonnelTeam3.ListCount > 0 Then
    bValidTeams = True
    Else
    bValidTeams = False
    GoTo false_start
    End If
    Return
    false_start:
    sMessage = "There must be at least one person assigned to each time " & _
    "before play can begin. Either add personnel to any empty " & _
    "teams or reduce the number of teams competing in this session."

    MsgBox sMessage, vbOKOnly, "Invalid Start"
    GoTo end_sub
    valid_start:
    If bValidTeams = True Then

    'tblSession
    sSQL1 = "INSERT INTO " & s_tblSession & " (SessionDate) " & _
    "VALUES (#" & Date & "#);"
    RunSQL sSQL1
    iSessionID = DMax("[SessionID]", "[" & s_tblSession & "]")

    'Set global variable for later use...
    gtCurrentGame.SessionID = iSessionID

    'tblSessionSetup
    With gtCurrentGame
    sSQL1 = "INSERT INTO " & s_tblSessionSetup & " (SessionID,CategoryCount,AnswerCount,TeamCount,Rou ndCount,MaxDifficulty,MinDifficulty) " & _
    "VALUES (" & iSessionID & "," & _
    .CategoryCount & "," & _
    .AnswerCount & "," & _
    .TeamCount & "," & _
    .RoundCount & "," & _
    .MaxDifficulty & "," & _
    .MinDifficulty & ");"
    RunSQL sSQL1
    .SetupID = DMax("[SetupID]", s_tblSessionSetup)
    End With

    'tblSessionTeam
    'Team 1
    With gtCurrentGame
    If .TeamCount >= 1 Then
    Set ctl = Me.lstPersonnelTeam1
    GoSub team_loop
    End If

    If .TeamCount >= 2 Then
    Set ctl = Me.lstPersonnelTeam2
    GoSub team_loop
    End If

    If .TeamCount >= 3 Then
    Set ctl = Me.lstPersonnelTeam3
    GoSub team_loop
    End If
    End With

    's_tblsessionexclude
    If Me.lstAnswerSource.ItemsSelected.Count > 0 Then
    For i = 0 To Me.lstAnswerSource.ListCount - 1
    If Me.lstAnswerSource.Selected(i) Then
    sSQL1 = "INSERT INTO " & s_tblSessionExclude & " (SessionID,AnswerID) " & _
    "VALUES (" & gtCurrentGame.SessionID & "," & Me.lstAnswerSource.ItemData(i) & ");"
    RunSQL sSQL1


    End If
    Next i
    End If
    End If

    Call jsn.RunGame

    'DoCmd.OpenForm FormName:=s_frmJeopardyBoard
    GoTo end_sub
    team_loop:
    For i = 0 To ctl.ListCount - 1
    sSQL1 = "INSERT INTO " & s_tblSessionTeam & " (SessionID,TeamNumber,PersonnelID) " & _
    "VALUES (" & gtCurrentGame.SessionID & "," & Right(ctl.Name, 1) & "," & ctl.ItemData(i) & ");"
    RunSQL sSQL1
    Next i
    Return
    end_sub:
    End Sub
    Private Sub cmdRandomAll_Click()
    Call RandomTeams("All")
    End Sub
    Private Sub cmdRandomSelected_Click()
    Call RandomTeams("Selected")
    End Sub
    Private Sub RandomTeams(sMode As String)
    Dim i As Integer
    Dim j As Integer
    Dim iTeamCount As Integer
    Dim iPersonnelCount As Integer
    Dim iExtraPersonnel As Integer
    Dim iRandomTeam1 As Integer
    Dim iRandomTeam2 As Integer
    Dim sSQL1 As String
    Dim sSQL2 As String
    Dim sCriteria As String
    Dim sMessage As String
    Dim dbs As Database
    Dim qdf As QueryDef
    Dim rst As Recordset
    Set dbs = CurrentDb

    Call Clear_TempTable

    Select Case sMode
    Case "All"
    'Create critera to select records for all available personnel
    sSQL1 = "SELECT " & s_tblPersonnel & ".PersonnelID, " & _
    "RndNum([PersonnelID]) " & _
    "FROM " & s_tblPersonnel & " " & _
    "WHERE Active=True " & _
    "ORDER BY RndNum([PersonnelID]);"
    Case "Selected"
    If Me.lstPersonnelAll.ItemsSelected.Count = 0 Then
    sMessage = "There are no personnel selected for " & _
    "team assignment. Please select at " & _
    "one person for team assignment or click on " & _
    "Randomize (All) to assign all available personnel " & _
    "to teams."
    MsgBox sMessage, vbOKOnly
    GoTo end_sub
    Else
    'Create SQL criteria statement to limit records to selected personnel
    For i = 0 To Me.lstPersonnelAll.ListCount - 1
    If Me.lstPersonnelAll.Selected(i) Then

    sCriteria = sCriteria & "," & Me.lstPersonnelAll.ItemData(i)
    End If
    Next i

    sCriteria = Right(sCriteria, Len(sCriteria) - 1)

    sSQL1 = "SELECT " & s_tblPersonnel & ".PersonnelID, " & _
    "RndNum([PersonnelID]) " & _
    "FROM " & s_tblPersonnel & " " & _
    "WHERE " & s_tblPersonnel & ".PersonnelID IN (" & sCriteria & ") " & _
    "ORDER By RndNum([PersonnelID]);"

    'Clear selections in .lstPersonnelAll
    For i = 0 To Me.lstPersonnelAll.ListCount - 1
    Me.lstPersonnelAll.Selected(i) = False
    Next i
    End If
    End Select

    'Create a temporary query and order the record randomly for team assignment
    With dbs
    Set qdf = .CreateQueryDef("", sSQL1)
    With qdf
    Set rst = .OpenRecordset(dbOpenSnapshot)
    With rst
    'Ensure there are records returned to prevent errors
    If .RecordCount > 0 Then
    'iTeamCount = gtCurrentGame.TeamCount
    iTeamCount = Me.txtTeamCount
    iPersonnelCount = Int(.RecordCount / iTeamCount) 'Number of people per team (remainders not counted)
    iExtraPersonnel = .RecordCount Mod iTeamCount

    'Do something with the extra people
    If iExtraPersonnel > 0 Then 'There are extra people somwhere
    'At least one extra person assumed
    Randomize
    iRandomTeam1 = Int(iTeamCount * Rnd + 1) 'Selects a random team to assign extra person to
    If iExtraPersonnel > 1 Then
    'There should never be more than 2 extra personnel with a maximum of 3 teams
    Do
    Randomize
    iRandomTeam2 = Int(iTeamCount * Rnd + 1)
    Loop Until iRandomTeam2 <> iRandomTeam1
    End If
    End If

    'Since recordset is in random order, start from the top and assign personnel to teams
    .MoveFirst
    Do Until .EOF
    For i = 1 To iTeamCount
    'IIF statement ensures all excess personnel are added to the randomly selected teams
    For j = 1 To iPersonnelCount + IIf(i = iRandomTeam1 Or i = iRandomTeam2, 1, 0)
    sSQL2 = "INSERT INTO " & s_tblTeamTemp & " (TeamNumber,PersonnelID) " & _
    "VALUES (" & i & "," & rst.Fields("PersonnelID") & ");"
    RunSQL sSQL2
    .MoveNext
    Next j
    Next i
    Loop
    End If
    .Close
    End With
    .Close
    End With
    End With

    Call Update_Labels(True)
    Call EnablePersonnelMovement(True)
    end_sub:
    Set dbs = Nothing
    Set qdf = Nothing
    Set rst = Nothing
    End Sub

  2. #2
    June7's Avatar
    June7 is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    51,755
    That's a lot of code and as posted, hard to read.

    Why is that problem line enclosed in []? What is jsn - a form or general code module?

    If you want to code, learn debugging. Refer to link at bottom of my post for debugging guidelines. For a start, step debug the code.
    Last edited by June7; 01-27-2014 at 05:19 PM.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    orange's Avatar
    orange is offline Moderator
    Windows XP Access 2003
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,439
    When you post a question in any forum
    -clearly state the problem (clear and concise)
    -tell us about WHAT you are trying to accomplish with this database
    -use code tags when posting code
    -identify what you have tried and what result (messages etc)

    see if this helps http://msdn.microsoft.com/en-us/libr...=vs.60%29.aspx

    Learn debugging as has been suggested already.
    Include Error Handling logic in all procedures.

    You may want to post on Utteraccess where you got the code --even PM the originator there,

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Military Time Blues
    By viperbyte in forum Forms
    Replies: 19
    Last Post: 04-14-2020, 06:45 AM
  2. Formatting military time into non-military time
    By WithoutPause in forum Access
    Replies: 3
    Last Post: 11-18-2013, 07:40 AM
  3. Replies: 42
    Last Post: 03-01-2013, 06:58 AM
  4. Replies: 14
    Last Post: 01-15-2013, 06:07 PM
  5. Military Time
    By tshirttom in forum Access
    Replies: 3
    Last Post: 07-29-2011, 01:29 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums