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