Run-time error '3265' Item cannot be found in the collection to the requested name or ordinal

Everytime I try opening the MS Access file, I receive the error mentioned in the title. Then, when I click the debug option, the following script comes up in the main code window, where "rstTablesADO.Find strField & " = " & LookFor" is highlighted:
"Option Explicit

Public Const blnMaintenance As Boolean = False
Public Const blnSquadron As Boolean = False

Public Const lngCurrentDayColor As Integer = 36

Public Const strBackUpDatabaseFile As String = "Blank Database.mdb"
Public Const strBackupDirectory As String = "JAMMIE Backup"
Public Const strDatabaseFileName As String = "JAMMIE Database.mdb"
Public Const strINIFile As String = "Undo.ini"
Public Const strErrorMessage As String = "Call Current Ops!"

'Read INI settings
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
   "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long

'Write INI settings
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias _
   "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, _
   ByVal lpFileName As String) As Long

Public Declare Function GetComputerName _
Lib "kernel32" Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, nSize As Long) As Long

Type tpeEvent
    Event As String
    Explanation As String
    ColorIndexBackground As Long
    ColorIndexText As Long
End Type

Type tpeFooter
    TotalAircraftOwned As Long
    DepotInputs(100, 1) As Long '(0 - Normal, 1 - Departures)
    ActualPossessed As Long
    TACCPossessed As Long
    CommittedAircraft As Long
    DeployedAircraft(100) As Long
    TACCDeployedAircraft As Long
    MaintenanceWithhold As Long
    TACCMaintenanceWithhold As Long
    TACCFlyableTrainingFence As Long
    TACCMXTraining As Long
    MXTraining As Long
    MXWithhold(2) As Double '(0 - Normal, 1 - % of yellow color start, 2 - % of red color start)
    TaskedAircraft(100) As Long
    TaskableAircraft As Long
    TACCTaskableAircraft As Long
    TaskableDeployedTraining As Long
    TACCTaskableDeployedTraining As Long
    PAC As Double
    TACCPAC As Double
    TaskableAircraftRemaining As Long
    TACCTaskableAircraftRemaining As Long
    CrewsTasked(100) As Long
    CrewsDeployed(100) As Long
    TotalCrewsTasked(4) As Long
    TotalCrewsDeployed(4) As Long
    TACCDeployedCrews As Long
    Percent(3) As Double
    TotalCrewsAvailable(3) As Long
    TotalCrewsRemaining(3) As Long
    TotalCombinedReserveTasked As Long
    TotalCombinedReservePercent As Double
    OSFenceAircraft(100) As Long
    OSFenceCrews As Long
    LocalFenceAircraft(100) As Long
    LocalFenceCrews As Long
    TotalFenceAircraft As Long
    TotalFenceCrews As Long
    MissionReadyCrews As Long
    ReserveActivatedCrews As Long
    TotalMissionReadyCrews As Long
End Type

Type tpeTables
    CFG As Long
    Crew As Long
    Event As Long
    EventType As Long
    MSN As Long
    Priority As Long
    SQType As Long
    Squadrons(1) As Long    '0-Null, 1-Unassinged
    Wing(1) As Long         '0-Null, 1-Other
End Type

Type tpeProgramConstant
    BackUpMonth As Long
    Button(10) As String
    ColumnWidth(1, 2) As Long   '(0-Letter, 1-Legal), (0-First, 1-Day, 2-Last)
    DocumentFolder As String
    EventLine As Long           'Event Lines Per Page
    FontSize(1) As Long         '0-Letter, 1-Legal
    PageScalling(1) As Long     '0-Letter, 1-Legal
    RowHeight(2) As Long        '0-Comment, 1-Squadron, 2-Title
    Squadrons(100, 5) As Variant
    ViewZoom(1) As Long         '0-Event, 1-Statistics
    Wing(1) As Variant          '0-ID, 1-Name
End Type

Dim lngColorIndexBackground As Long, lngColorIndexText As Long

Public Const conAdd As Integer = 1, conDelete As Integer = 2, conEdit As Integer = 3
Public Const conNoChange As Integer = 5

Public Const conLinkFront As Integer = 4, conDelinkFront As Integer = 5
Public Const conLinkBack As Integer = 6, conDelinkBack As Integer = 7, conCANX As Integer = 8
Public Const strFolderLocation As String = "In Your Documents Directory Under "

Public Const conBlack As Integer = 0
Public Const conBlue As Long = 16711680
Public Const conGreen As Long = 32768
Public Const conGrey As Long = 12632256
Public Const conGreenBright As Long = 65280
Public Const conGreenDark As Long = 32768
Public Const conRed As Integer = 255
Public Const conWhite As Long = 16777215
Public Const conYellow As Long = 5298411

Public Const conTransparent = 0
Public Const conSolid = 1

Public Const MAX_COMPUTERNAME_LENGTH As Long = 15&
Public Const MAX_PATH As Integer = 260

Public blnAutoClose As Boolean, blnButton As Boolean, blnTemp As Boolean
Public conEvent(50) As tpeEvent
Public Constant As tpeProgramConstant
Public ctlLostFocus As control
Public dblPAC As Double, dblPercentRedStart As Double, dblPercentYellowStart As Double, _
    dblTemp As Double
Public dteTemp As Date
Public dteEnd As Date, dteFirst As Date, dteLast As Date, dteTACCEnd As Date, _
    dteTACCStart As Date, dteStart As Date
Public dteOriginalEnd, dteOriginalStart, dteRelativeStart As Date
Public lngCounter As Long, lngNumberDays As Long, lngOrder As Long, lngOverallNumberDays As Long, _
    lngPercent As Long, lngStartField As Long, lngTemp As Long
Public lngArrayNumber As Long
Public lngListCountAdjustment As Long
Public lngNullValues As tpeTables
Public lngPreviousFormNameCounter As Long
Public lngRowsToIgnore As Long
Public lngSQ(4, 2) As Long
Public lngTableCountAdjustment As Long
Public Numbers(63) As tpeFooter
Public strBenutzer As String
Public strDatabase As String, _
    strFile As String, strLocation As String, strPath As String, _
    strRootFolder As String, strSQL As String, strSQ(4, 2) As String, _
    strTemp As String
Public strInfoText As String
Public strPreviousFormName(100) As String
Public strProgramVersion As String
Public strTableDesignator  As String
Public strTableDesignatorTwo  As String
Public varbookmark, varTemp
Public varTableArray(7, 100, 1000)          '1-Event, 2-Squadron, 3-Availability/Trip List Output
                                            '7-Wing

Public Function fnAddDaysToAvailability(dteStart, dteEnd)

    Dim dteTemp As Date
    Dim lngActive As Long, lngAircraft As Long, lngDepot As Long, _
        lngLocalFenceAircraft As Long, lngLocalFenceCrews As Long, lngMRCrews As Long, _
        lngMXTraining As Long, lngMXWithhold As Long, lngReserve As Long, _
        lngTACCDeployed As Long, lngTACCDeployedCrews As Long, lngTACCFlyableTraining As Long, _
        lngTACCMXTraining As Long, lngTACCPossessed As Long, lngTACCTaskable As Long
    Dim lngReserveCrewsActivated As Long
        
    strSQL = "SELECT * FROM defaults;"
    
'Debug.Print strSQL
    
    rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
    
    If Not rstTempADO.EOF Then
        
        rstTempADO.MoveFirst
        
        lngTACCPossessed = rstTempADO!tacc_possessed
        lngActive = rstTempADO!Active
        lngReserve = rstTempADO!reserve
        lngTACCDeployedCrews = rstTempADO!tacc_deployed_crews
        lngAircraft = rstTempADO!aircraft
        lngTACCFlyableTraining = rstTempADO!tacc_flyable_training
        lngTACCMXTraining = rstTempADO!tacc_mx_training
        lngMXWithhold = rstTempADO!mx_withhold
        lngTACCDeployed = rstTempADO!tacc_deployed
        lngTACCTaskable = rstTempADO!tacc_taskable
        lngMRCrews = rstTempADO!active_mr_crews
        lngLocalFenceCrews = rstTempADO!local_fence_crews
        lngLocalFenceAircraft = rstTempADO!local_fence_aircraft
        lngMXTraining = rstTempADO!mx_training
        lngReserveCrewsActivated = rstTempADO!reserve_mr_crews
            
    End If
    
    rstTempADO.Close

    fnImportTableIntoArray 3, dteStart, dteEnd
    
    dteTemp = dteStart
    
    Do
    
        lngTemp = fnFindIDinArray(3, 0, dteTemp)
        
        If lngTemp = 0 Then
        
            strSQL = "INSERT INTO availability ( datum, taccactive, taccreserve, aircraft, " & _
                "taccflyabletraining, taccmxtraining, mxtraining, mxwithhold, " & _
                "taccpossessedaircraft, taccdeployed, tacctaskable, taccmrcrews, " & _
                "taccdeployedcrews, localtrainingcrews, localtrainingaircraft, " & _
                "reservecrewsactivated ) " & _
                "VALUES ( #" & dteTemp & "#, " & _
                lngActive & ", " & _
                lngReserve & ", " & _
                lngAircraft & ", " & _
                lngTACCFlyableTraining & ", " & _
                lngTACCMXTraining & ", " & _
                lngMXTraining & ", " & _
                lngMXWithhold & ", " & _
                lngTACCPossessed & ", " & _
                lngTACCDeployed & ", " & _
                lngTACCTaskable & ", " & _
                lngMRCrews & ", " & _
                lngTACCDeployedCrews & ", " & _
                lngLocalFenceCrews & ", " & _
                lngLocalFenceAircraft & ", " & _
                lngReserveCrewsActivated & " );"

            dbADO.Execute strSQL
            
        End If
        
        dteTemp = DateAdd("d", 1, dteTemp)

    Loop Until dteTemp = DateAdd("d", 1, dteEnd)
    
End Function

Public Function fnAddDeleteInUse(lngFrontLink, lngID, lngBackLink)

On Error GoTo Err_AddDeleteInUse

    'Delete all records with that Username
    strSQL = "DELETE " & _
        "FROM InUse " & _
        "WHERE benutzer = '" & strBenutzer & "';"
        
    dbADO.Execute strSQL
    
    If Not lngFrontLink = 0 Then
    
        strSQL = "INSERT INTO InUse ( ID, benutzer ) " & _
            "VALUES (" & lngFrontLink & ", '" & strBenutzer & "');"
    
        dbADO.Execute strSQL
    
    End If
    
    If Not lngBackLink = 0 Then
    
        strSQL = "INSERT INTO InUse ( ID, benutzer ) " & _
            "VALUES (" & lngBackLink & ", '" & strBenutzer & "');"
    
        dbADO.Execute strSQL
    
    End If
    
    If Not lngID = 0 Then
    
        strSQL = "INSERT INTO InUse ( ID, benutzer ) " & _
            "VALUES (" & lngID & ", '" & strBenutzer & "');"
    
        dbADO.Execute strSQL
    
    End If
    
    Exit Function
    
Err_AddDeleteInUse:
    
    Select Case Err.Number
        Case -2147217865, -2147217904
            Resume Next
        Case 3420, 91
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "fnAddDeleteInUse"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnAddSubtractDay(cntTemp, intASCII) As Boolean
    
On Error GoTo Err_fnAddSubtractDay

    fnAddSubtractDay = True

    Select Case intASCII
        Case 43
            cntTemp.Value = Format(DateAdd("d", 1, Left(cntTemp.Value, 2) & "-" & _
                Mid(cntTemp.Value, 3, 2) & "-" & Right(cntTemp.Value, 2)), "mmddyy")
        Case 45
            cntTemp.Value = Format(DateAdd("d", -1, Left(cntTemp.Value, 2) & "-" & _
                Mid(cntTemp.Value, 3, 2) & "-" & Right(cntTemp.Value, 2)), "mmddyy")
    End Select

    Exit Function

Err_fnAddSubtractDay:

    Select Case Err.Number
        Case 13
            fnAddSubtractDay = False
        Case 51
            Resume Next
        Case Else
            fnErrorHandler "fnAddSubtractDay"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnBackup() As String

On Error GoTo Err_fnBackup

    If blnSquadron Then Exit Function
    
    Dim lngBackupCounter As Long
    Dim strTableName As String
    
    DoCmd.OpenForm "Progress", , , , , , "Backing Up Data"
    
    Forms!Progress.Repaint
    Forms!Progress.pbProgress.Max = varTableArray(6, 0, 0) + 3
    
    'If the directory already existed do the following
    If fnCreateDirectory(strRootFolder, strBackupDirectory) = False Then
        
        strFile = Dir(strRootFolder & strBackupDirectory & "\*Backup.mdb")
        
        'Delete all Backup Files that are older than 8 days
        Do While strFile <> ""
        
            If Val(Left(strFile, 8)) < Val(Format(DateAdd("d", -8, Now()), "yyyymmdd")) Then
                Kill strRootFolder & strBackupDirectory & "\" & strFile
            End If
                
            strFile = Dir
        
        Loop
    
    End If
    
    Forms!Progress.pbProgress.Value = Forms!Progress.pbProgress.Value + 1
    
    strFile = strRootFolder & strBackupDirectory & "\" & Format(Now(), "yyyymmdd hhmmss") & _
        " Backup.mdb"

    Forms!Progress.pbProgress.Value = Forms!Progress.pbProgress.Value + 1
    
    FileCopy Application.CurrentProject.Path & "\" & strBackUpDatabaseFile, strFile
    
    Forms!Progress.pbProgress.Value = Forms!Progress.pbProgress.Value + 1
    
    For lngBackupCounter = 1 To varTableArray(6, 0, 0)
    
        fnBackupInto varTableArray(6, 0, lngBackupCounter)
        
        Forms!Progress.pbProgress.Value = Forms!Progress.pbProgress.Value + 1
    
    Next
    
    fnBackup = strFile
    
    DoCmd.Close acForm, "Progress"
    
    Exit Function
    
Err_fnBackup:
    
    Select Case Err.Number
        Case -2147217843
            fnSetDatabase
            Resume
        Case 70, 75
            Resume Next
        Case 53
            Exit Function
        Case Else
            fnErrorHandler "fnBackup"
            MsgBox strErrorMessage
            Resume Next
    End Select
    
End Function

Public Function fnChangeColors(xls, strField, lngSelection)
    
    Dim strCellValue As String
    
    xls.Range(strField).Select
    
    strCellValue = xls.ActiveCell.Value
    
    With xls
    
        Select Case lngSelection
            Case 1
                fnChangeEventColor strCellValue
            Case 2
                fnGreenYellowRed strCellValue
            Case 3
                fnChangeSquadronColor strCellValue
            Case 4
                fnChangeDayColor strCellValue
            Case 5
                fnGreenYellowRedPercent
        End Select
        
    End With
        
    xls.Range(strField).Interior.ColorIndex = lngColorIndexBackground
    xls.Range(strField).Font.ColorIndex = lngColorIndexText
            
End Function

Public Function fnChangeDayColor(strCellValue)

    lngColorIndexBackground = 2
    lngColorIndexText = 1
    
    Select Case UCase(strCellValue)
        Case "SAT", "SUN"
            lngColorIndexBackground = 34
    End Select
    
End Function

Public Function fnChangeEventColor(strCellValue)

    lngColorIndexBackground = 2
    lngCounter = 0
    lngColorIndexText = 1
    
    Do While conEvent(lngCounter).Event <> ""
    
        If strCellValue = conEvent(lngCounter).Event Then
        
            lngColorIndexBackground = conEvent(lngCounter).ColorIndexBackground
            lngColorIndexText = conEvent(lngCounter).ColorIndexText
    
            Exit Do
        
        End If
        
        lngCounter = lngCounter + 1
        
    Loop
    
End Function

Public Function fnChangeOrder( _
    lst As ListBox, _
    DownDirection As Boolean, _
    TableName As String, _
    CriteriaColumn As String, _
    CriteriaValue As Long, _
    OrderColumnName As String, _
    OrderColumnValue As Long, _
    ListCountAdjustment As Long) As Long

On Error GoTo Hell

    Dim lngFrom As Long, lngTo As Long
    Dim strSQL As String
    
    lngFrom = OrderColumnValue
    
    If (lngFrom = 1 And DownDirection = False) _
        Or (lngFrom = lst.ListCount - ListCountAdjustment And DownDirection = True) Then
    
        Exit Function
        
    Else
    
        strSQL = "UPDATE " & TableName & " SET " & _
            OrderColumnName & " = 0 " & _
            "WHERE (" & CriteriaColumn & " = " & CriteriaValue & " " & _
            "AND " & OrderColumnName & " = " & OrderColumnValue & ");"
        
        dbADO.Execute strSQL

    End If
    
    If DownDirection = True Then
        lngTo = lngFrom + 1
    Else
        lngTo = lngFrom - 1
    End If
    
    strSQL = "UPDATE " & TableName & " SET " & _
        OrderColumnName & " = " & lngFrom & " " & _
        "WHERE (" & CriteriaColumn & " = " & CriteriaValue & " " & _
        "AND " & OrderColumnName & "=" & lngTo & ");"
    
    dbADO.Execute strSQL
    
    strSQL = "UPDATE " & TableName & " SET " & _
        OrderColumnName & " = " & lngTo & " " & _
        "WHERE (" & CriteriaColumn & " = " & CriteriaValue & " " & _
        "AND " & OrderColumnName & "=0);"

    dbADO.Execute strSQL
    
    fnChangeOrder = lngTo
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3240
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnChangeOrder"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnChangeOrderSimple( _
    lst As ListBox, _
    TableName As String, _
    OrderColumnName As String, _
    OrderColumnValue As Long, _
    AddSubtractNumber As Long, _
    ListCountAdjustment As Long, _
    TableCountAdjustment As Long, _
    Form As Form) As Long

On Error GoTo Hell

    fnCheckSession Form.Name

    Dim lngFrom As Long, lngTo As Long
    Dim strSQL As String
    
    lngFrom = OrderColumnValue
    
    If (lngFrom - TableCountAdjustment = 1 And AddSubtractNumber < 0) _
        Or (lngFrom - TableCountAdjustment = lst.ListCount - ListCountAdjustment _
        And AddSubtractNumber > 0) Then Exit Function
        
    lngTo = lngFrom + AddSubtractNumber
    
    strSQL = "UPDATE " & TableName & " SET " & _
        OrderColumnName & " = 0 " & _
        "WHERE (" & OrderColumnName & "=" & lngFrom & ");"
    
    dbADO.Execute strSQL
    
    strSQL = "UPDATE " & TableName & " SET " & _
        OrderColumnName & " = " & lngFrom & " " & _
        "WHERE (" & OrderColumnName & "=" & lngTo & ");"
    
    dbADO.Execute strSQL
    
    strSQL = "UPDATE " & TableName & " SET " & _
        OrderColumnName & " = " & lngTo & " " & _
        "WHERE (" & OrderColumnName & "=0);"

    dbADO.Execute strSQL
    
    fnChangeOrderSimple = lngTo
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3240
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnChangeOrderSimple"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnChangeSquadronColor(strCellValue)

    lngColorIndexBackground = 2
    lngCounter = 1
    lngColorIndexText = 1
    
    Do While lngCounter < 7
    
        If strCellValue = Constant.Squadrons(lngCounter, 0) Then
        
            lngColorIndexBackground = Constant.Squadrons(lngCounter, 2)
            lngColorIndexText = Constant.Squadrons(lngCounter, 3)
    
            Exit Do
        
        End If
        
        lngCounter = lngCounter + 1
        
    Loop
    
End Function

Public Function fnCheckControl( _
    clt As control, _
    blnMessage As Boolean) As Boolean

On Error GoTo Err_fnCheckControl
    
    If clt.Visible Then
    
'        clt.SetFocus
        
        'varTemp = clt.Text
        varTemp = clt
        
    Else
    
        varTemp = Null
        
    End If

    If Trim(clt.Value) = "" Or IsNull(clt.Value) = True Or varTemp = "" Then
    
        If blnMessage Then
            MsgBox clt.Tag & " Required"
            clt.SetFocus
        End If
        
        fnCheckControl = False
        
        Exit Function
        
    End If
    
    fnCheckControl = True

    Exit Function

Err_fnCheckControl:
    
    Select Case Err.Number
        Case 438
            varTemp = Null
            Resume Next
        Case Else
            fnErrorHandler "fnCheckControl"
            MsgBox strErrorMessage
            Resume Next
    End Select

End Function

'Public Function fnCheckControl(clt) As Boolean

'    If Trim(clt.Value) = "" Or IsNull(clt.Value) = True Then
'        MsgBox clt.Tag & " Required"
'        clt.SetFocus
'        fnCheckControl = False
'        Exit Function
'    End If
    
'    fnCheckControl = True

'End Function

Public Function fnCheckForItemInList( _
    LookingFor, InList As Object, ListColumn As Long) As Variant

    Dim lngRowCounter As Long
    Dim varItem As Variant
    
    fnCheckForItemInList = Null
    
    If IsNull(LookingFor) Then Exit Function
    
    If InList.ListCount = 0 Then Exit Function
    
    For lngRowCounter = 0 To InList.ListCount
    
        varTemp = Nz(InList.Column(ListColumn, lngRowCounter), "-1")
        
        If varTemp = "" Then varTemp = "-1"
        
        If Val(varTemp) = Val(LookingFor) Then
        
            InList.Value = InList.ItemData(lngRowCounter)
            
            fnCheckForItemInList = lngRowCounter
            
            Exit Function
            
        End If
        
    Next
    
End Function

Public Function fnCheckInUse(lngID) As Boolean
    
    Dim lngRecordCount As Long
    Dim varRecordUsername As Variant, varUsername As Variant
    
    fnCheckInUse = False
    
    If IsNull(lngID) Then Exit Function
    
    strSQL = fnSelectInUseID(lngID)
    
    rstTablesADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
    
    lngRecordCount = rstTablesADO.RecordCount
    
    If Not rstTablesADO.EOF Then
        rstTablesADO.MoveFirst
        varRecordUsername = rstTablesADO!benutzer
    End If
    
    rstTablesADO.Close
    
    varUsername = fnGetUsername

    If IsEmpty(varRecordUsername) = False And varRecordUsername <> varUsername Then
        
        MsgBox "User: " & varRecordUsername & _
            " Is Currently Working With One Of The Effected Records!"
        
        fnCheckInUse = True
        
    End If
    
End Function

Public Function fnCheckSession(FormName As String) As Boolean

    fnCheckSession = True
    
    If strDatabase = "" Then
        
        MsgBox "Session Was Interrupted! Attempting to Reconnect and Return To Main Menu!"
        
        fnCloseOpenForm FormName, "Main"
        
        fnCheckSession = False
    
    End If

End Function

Public Function fnClearField(Record, FieldName As Object)

    FieldName = Null
    Record!Change = Now()
    Record.Update
    
End Function

Public Function fnClearRowCells(ctl, RowCount, ColumnCount)
    
    Dim lngControlCounter As Long
    Dim lngRowCounter As Long
    
    For lngRowCounter = 1 To RowCount
        For lngControlCounter = 1 To ColumnCount
            ctl(lngRowCounter, lngControlCounter) = ""
        Next
    Next
    
End Function

Public Function fnClearRowColor(ctl, ListRowToClear, ColumnCount, ScollValue)
    
    Dim lngControlCounter As Long
        
    For lngControlCounter = 1 To ColumnCount
        
        If IsEmpty(varTableArray(lngArrayNumber, 98, ListRowToClear + ScollValue)) Then
        
            ctl(ListRowToClear, lngControlCounter).BackColor _
                = conWhite
        
        Else
        
            ctl(ListRowToClear, lngControlCounter).BackColor _
                = varTableArray(lngArrayNumber, 98, ListRowToClear + ScollValue)
            ctl(ListRowToClear, lngControlCounter).ForeColor _
                = varTableArray(lngArrayNumber, 99, ListRowToClear + ScollValue)
                
        End If
    
        ctl(ListRowToClear, lngControlCounter).BorderStyle = conTransparent
    
    Next
            
End Function

Public Function fnCloseCurrentFormOpenNext(CurrentForm As Form, NewFormName As String)

    blnButton = True
    
    If fnCheckSession(CurrentForm.Name) = False Then Exit Function
    
    lngPreviousFormNameCounter = lngPreviousFormNameCounter + 1
    strPreviousFormName(lngPreviousFormNameCounter) = CurrentForm.Name
    
    fnCloseOpenForm CurrentForm.Name, NewFormName

End Function

Public Function fnCloseCurrentFormOpenPrevious(CurrentForm As Form)

    blnButton = True

    If fnCheckSession(CurrentForm.Name) = False Then Exit Function
    
    'If the form was entered from the "Select Person" form an extra form count
    'needs to be deleted
    If strPreviousFormName(lngPreviousFormNameCounter) = "Select Person" Then
        lngPreviousFormNameCounter = lngPreviousFormNameCounter - 1
    End If
    
    fnCloseOpenForm CurrentForm.Name, strPreviousFormName(lngPreviousFormNameCounter)
    
    If lngPreviousFormNameCounter > 0 Then
        lngPreviousFormNameCounter = lngPreviousFormNameCounter - 1
    End If
    
End Function

Public Function fnCloseOpenForm(objClose, objOpen)

    Dim strClose As String, strOpen As String
    
    DoCmd.Close acForm, objClose
    DoCmd.OpenForm objOpen

End Function

Public Function fnConfigureTables()

On Error GoTo Hell

    'This is only used when manually configuring tables
'    fnOpenADOConnection
    
    fnCreatePrimaryIndex "availability_datumid", "availability", "datum"
    
    fnCreatePrimaryIndex "buttons_idid", "buttons", "id"
    
    fnCreatePrimaryIndex "cfg_idid", "cfg", "id"
    
    fnCreatePrimaryIndex "colors_idid", "colors", "id"
    
    fnCreatePrimaryIndex "ce_eventid", "color_event", "event"
    
    fnCreatePrimaryIndex "cs_squadronsid", "color_squadrons", "squadrons"
    
    fnCreatePrimaryIndex "cw_wingid", "color_wing", "wing"
    
    fnCreatePrimaryIndex "constants_idid", "constants", "id"
    
    fnCreatePrimaryIndex "crew_idid", "crew", "id"
    
    fnCreatePrimaryIndex "dates_idid", "dates", "id"
    
    fnCreatePrimaryIndex "defaults_idid", "defaults", "id"
    
    fnCreatePrimaryIndex "event_idid", "event", "id"
    
    fnCreatePrimaryIndex "eventtype_idid", "eventtype", "id"
    
    fnCreatePrimaryIndex "inuse_idid", "inuse", "id"
    
    fnCreatePrimaryIndex "msn_idid", "msn", "id"
    
    fnCreatePrimaryIndex "patch_idid", "patch", "id"
    
    fnCreatePrimaryIndex "priority_idid", "priority", "id"
    
    fnCreatePrimaryIndex "sqtype_idid", "sqtype", "id"
    
    fnCreatePrimaryIndex "squadrons_idid", "squadrons", "id"
    
    fnCreatePrimaryIndex "taskings_idid", "taskings", "id"
    fnCreateIndex "taskings_startid", "taskings", "start"
    fnCreateIndex "taskings_endid", "taskings", "end"
    fnCreateIndex "taskings_startid_endid", "taskings", "start,end"
    fnCreateIndex "taskings_eventid", "taskings", "event"
    fnCreateIndex "taskings_frontlinkid", "taskings", "frontlink"
    fnCreateIndex "taskings_backlinkid", "taskings", "backlink"
    
    fnCreatePrimaryIndex "wing_idid", "wing", "id"
    
    'This is only used when manually configuring tables
'    fnCloseADOConnection
    
    Exit Function
    
Hell:
    
    Select Case Err.Number
        Case 70, 75, 3146, -2147467259
'            fnErrorHandler "fnExportInto"
            Resume Next
        Case 53
            Exit Function
        Case Else
            fnErrorHandler "fnExportInto"
            MsgBox strErrorMessage
            Resume Next
    End Select
    
End Function

Public Function fnConvertColumNumberToLetters(lngColumnNumber) As String

    Dim lng As Long
    
    lng = lngColumnNumber + 64
    
    Select Case lng
        Case Is < 91
            fnConvertColumNumberToLetters = Chr(lng)
        Case 91 To 116
            fnConvertColumNumberToLetters = "A" & Chr(lng - 26)
        Case Else
            fnConvertColumNumberToLetters = "B" & Chr(lng - 52)
    End Select
    
End Function

Public Function fnConvertValueToDate(control) As String
    
    fnConvertValueToDate = Left(control.Value, 2) & "-" & Mid(control.Value, 3, 2) & "-" & _
        Right(control.Value, 2)
    
End Function

Public Function fnCountSquadronTraining(obj As tpeFooter, EventType)
    
    Dim lngSQCount As Long
    
    With obj
    
        'Count Squadron
        For lngTemp = 1 To 4
        
            For lngSQCount = 1 To varTableArray(2, 0, 0)
            
                If Constant.Squadrons(lngSQCount, 5) <> 0 And lngSQ(lngTemp, 0) <> 0 Then
                    
                    If Constant.Squadrons(lngSQCount, 5) = lngSQ(lngTemp, 0) _
                        And Constant.Squadrons(lngSQCount, 4) = "1" Then
                    
                        'Local
                        If EventType = 5 Then
                            .LocalFenceCrews = .LocalFenceCrews + 1
                        Else
                            .OSFenceCrews = .OSFenceCrews + 1
                        End If
                        
                        Exit For
                        
                    End If
                    
                Else
                    Exit For
                End If
                
            Next
            
        Next
        
    End With
    
End Function

Public Function fnCountSquadronTaskings( _
    EventType As Long, _
    obj As tpeFooter, _
    objOverall As tpeFooter)
    
    Dim lngSQCount As Long
    
    With obj
    
        'Count Squadron Taskings
        For lngTemp = 1 To 4
        
            For lngSQCount = 1 To varTableArray(2, 0, 0)
            
                If Constant.Squadrons(lngSQCount, 5) <> 0 And lngSQ(lngTemp, 0) <> 0 Then
                    
                    If Constant.Squadrons(lngSQCount, 5) = lngSQ(lngTemp, 0) Then
                    
                        'Chopped
                        If EventType = 2 Then
                            .CrewsDeployed(lngSQCount) = .CrewsDeployed(lngSQCount) + 1
                            objOverall.CrewsDeployed(lngSQCount) _
                                = objOverall.CrewsDeployed(lngSQCount) + 1
                        Else
                            .CrewsTasked(lngSQCount) = .CrewsTasked(lngSQCount) + 1
                            objOverall.CrewsTasked(lngSQCount) _
                                = objOverall.CrewsTasked(lngSQCount) + 1
                        End If
                        
                        Exit For
                        
                    End If
                    
                Else
                    Exit For
                End If
                
            Next
            
        Next
        
    End With

End Function

Public Function fnCountWingTaskings( _
    EventType As Long, _
    obj As tpeFooter, _
    objOverall As tpeFooter, _
    LookForWingID As Long)
    
    Dim lngWingCount As Long
    
    'Count Wing Taskings, Start at 2 to ignore None Wings
    For lngWingCount = 2 To varTableArray(7, 0, 0)
    
        If varTableArray(7, 0, lngWingCount) <> 0 And LookForWingID <> 0 Then
            
            If varTableArray(7, 0, lngWingCount) = LookForWingID Then
            
                'Chopped
                If EventType = 2 Then
                    obj.DeployedAircraft(lngWingCount) = obj.DeployedAircraft(lngWingCount) + 1
                    objOverall.DeployedAircraft(lngWingCount) _
                        = objOverall.DeployedAircraft(lngWingCount) + 1
                Else
                    obj.TaskedAircraft(lngWingCount) = obj.TaskedAircraft(lngWingCount) + 1
                    objOverall.TaskedAircraft(lngWingCount) _
                        = objOverall.TaskedAircraft(lngWingCount) + 1
                End If
                
                Exit For
                
            End If
            
        Else
            Exit For
        End If
            
    Next lngWingCount
            
End Function

Public Function fnCountWingTraining( _
    ColumnDate, _
    DepartureDate As Date, _
    EventType As Long, _
    obj As tpeFooter, _
    objOverall As tpeFooter, _
    LookForWingID As Long)
    
    Dim lngWingCount As Long
    
    'Count Wing Taskings, Start at 2 to ignore None Wings
    For lngWingCount = 2 To varTableArray(7, 0, 0)
    
        If varTableArray(7, 0, lngWingCount) <> 0 And LookForWingID <> 0 Then
            
            If varTableArray(7, 0, lngWingCount) = LookForWingID Then
            
                'Local
                If EventType = 5 Then
                    obj.LocalFenceAircraft(lngWingCount) = obj.LocalFenceAircraft(lngWingCount) + 1
                    objOverall.LocalFenceAircraft(lngWingCount) _
                        = objOverall.LocalFenceAircraft(lngWingCount) + 1
                ElseIf EventType = 3 Then
                    
                    If DateValue(ColumnDate) = _
                        DateValue(DepartureDate) Then
                        obj.DepotInputs(lngWingCount, 1) = obj.DepotInputs(lngWingCount, 1) + 1
                    End If
                    
                    obj.DepotInputs(lngWingCount, 0) = obj.DepotInputs(lngWingCount, 0) + 1
                    objOverall.DepotInputs(lngWingCount, 0) _
                        = objOverall.DepotInputs(lngWingCount, 0) + 1
                Else
                    obj.OSFenceAircraft(lngWingCount) = obj.OSFenceAircraft(lngWingCount) + 1
                    objOverall.OSFenceAircraft(lngWingCount) _
                        = objOverall.OSFenceAircraft(lngWingCount) + 1
                End If
                
                Exit For
                
            End If
            
        Else
            Exit For
        End If
            
    Next lngWingCount
            
End Function

Public Function fnCreateDirectory( _
    strRootDirectoryPath As String, _
    strDirectoryName As String) As Boolean

    Dim strDirectory As String
        
    strDirectory = Dir(strRootDirectoryPath, vbDirectory)
    
    Do While strDirectory <> ""
    
        If strDirectory = strDirectoryName Then
        
            fnCreateDirectory = False
            
            Exit Function
        
        End If
        
        strDirectory = Dir
        
    Loop
    
    MkDir strRootDirectoryPath & strDirectoryName

    fnCreateDirectory = True
    
End Function

Public Function fnCreateIndex( _
    IndexName As String, _
    TableName As String, _
    FieldNames As String)

On Error GoTo Hell

    strSQL = "CREATE INDEX " & IndexName & " " & _
    "ON " & TableName & " (" & FieldNames & ");"
    
'Debug.Print strSQL

    dbADO.Execute strSQL
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 3283, 3375, -2147467259, -2147217900
            Resume Next
        Case Else
            fnErrorHandler "Main / fnCreateIndex"
            MsgBox strErrorMessage
            Resume Next
    End Select

End Function

Public Function fnCreatePrimaryIndex( _
    UniqueIndexName As String, _
    TableName As String, _
    FieldNames As String)

On Error GoTo Hell

    strSQL = "CREATE UNIQUE INDEX " & UniqueIndexName & " " & _
        "ON " & TableName & " (" & FieldNames & ");"
    
    dbADO.Execute strSQL
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 3283, -2147467259, -2147217900, -2147217865
            Resume Next
        Case Else
            fnErrorHandler "Main / fnCreatePrimaryIndex"
            MsgBox strErrorMessage
            Resume Next
    End Select

End Function

Public Function fnCurrentMachineName() As String

    Dim lSize As Long
    Dim sBuffer As String
    
    sBuffer = Space$(MAX_COMPUTERNAME_LENGTH + 1)
    lSize = Len(sBuffer)

    If GetComputerName(sBuffer, lSize) Then
        fnCurrentMachineName = Left$(sBuffer, lSize)
    End If

End Function

Public Function fnFillComboGeneric(TableName As String, FieldName As String, cb As ComboBox)

    strSQL = "SELECT id, " & FieldName & " " & _
        "FROM " & TableName & " " & _
        "ORDER BY " & FieldName & ";"

'Debug.Print strSQL & Chr(10)
    
    fnFillRowSourse cb, strSQL, ""
    
End Function

Public Function fnFillComboStandard(TableName As String, cb As ComboBox, RowsToIgnore)

    strSQL = "SELECT id, lang, kurz " & _
        "FROM " & TableName & " " & _
        "WHERE folge > " & RowsToIgnore & " " & _
        "ORDER BY folge;"

'Debug.Print strSQL & Chr(10)
    
    fnFillRowSourse cb, strSQL, ""
    
End Function

Public Function fnFillComboColorIndexes(ComboBackground As ComboBox, ComboText As ComboBox)

    strSQL = "SELECT ColorIndex FROM Colors ORDER BY ColorIndex;"
        
    fnFillRowSourse ComboBackground, strSQL, ""
    fnFillRowSourse ComboText, strSQL, ""

End Function

Public Function fnFillComboEvent(cb As ComboBox) As Boolean

On Error GoTo Hell

    fnFillComboEvent = True
    
    strSQL = "SELECT id, lang FROM event  " & _
        "ORDER BY folge;"
        
'Debug.Print strSQL

    fnFillRowSourse cb, strSQL, ""
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3420, 3240, -2147217843
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnFillComboEvent"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnFillRowSourse(cb As control, SQLStatement As String, Heading As String)

On Error GoTo Hell

'Debug.Print SQLStatement

    rstTempADO.Open SQLStatement, dbADO, adOpenStatic, adLockReadOnly
    
    If rstTempADO.EOF Then
        cb.RowSource = ""
    Else
        cb.RowSource = Heading & rstTempADO.GetString(adClipString, , ";", ";")
    End If
    
    rstTempADO.Close
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3420, 3240
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnFillRowSource"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnFindColorNumber(ColorIndexNumber) As Long

    Dim intBlue As Integer
    Dim intGreen As Integer
    Dim intRed As Integer
    
    lngTemp = fnFindIDinArray(5, 0, ColorIndexNumber)
    
    intBlue = varTableArray(5, 1, lngTemp)
    intGreen = varTableArray(5, 2, lngTemp)
    intRed = varTableArray(5, 3, lngTemp)

    fnFindColorNumber = RGB(intRed, intGreen, intBlue)

End Function

Public Function fnFindMaxID(TableName) As Long

    Dim strSQL As String
    Dim varMaxID
    
    strSQL = "SELECT MAX(id) as lastid FROM " & TableName & ";"
    
    rstTablesADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly, adCmdText
    
    varMaxID = rstTablesADO!lastid
    
    If IsNull(varMaxID) Then
        fnFindMaxID = 0
    Else
        fnFindMaxID = varMaxID
    End If
    
    rstTablesADO.Close

End Function

Public Function fnFindRecordID(strRecord, strField, LookFor) As Long
    
    'I guess this function finds the record that corresponse to the record that
    'depicts none or n/a
    
    rstTablesADO.Open strRecord, dbADO, adOpenStatic, adLockReadOnly
    
        rstTablesADO.Find strField & " = " & LookFor

    fnFindRecordID = rstTablesADO!Id
    
    rstTablesADO.Close

End Function

Public Function fnFindRecordInSQLRecordset(Record, lngID) As Boolean
    
On Error GoTo Hell

    Record.MoveLast
    Record.MoveFirst
    
    fnFindRecordInSQLRecordset = False
    
    'Find first record satisfying search criteria
    Record.Find "ID = " & Trim(Str(lngID))
    
    If Not Record.EOF Then
       'successful search
       fnFindRecordInSQLRecordset = True
       
    End If
    
    Exit Function
    
Hell:

    Select Case Err.Number
    Case -2147217885
    End Select
    
End Function

Public Function fnDeleteCreateFile( _
    FileCriteria As String, _
    DeleteFiles As Boolean, _
    TemplateFile As Boolean) As String

On Error GoTo Err_fnDeleteCreateFile

    Dim strDeleteCreateFolder As String

    strDeleteCreateFolder = strRootFolder & Constant.DocumentFolder & "\"
    strFile = Dir(strDeleteCreateFolder & "*" & FileCriteria)
    
'Debug.Print strFile
    
    If DeleteFiles Then
    
        'Delete all Files
        Do While strFile <> ""
        
            Kill strDeleteCreateFolder & strFile
                
            strFile = Dir
        
        Loop
        
    End If
    
    fnDeleteCreateFile = strDeleteCreateFolder & _
        Format(Now(), "yyyymmdd hhmmss") & " " & FileCriteria
    
'Debug.Print fnDeleteCreateFile

    If TemplateFile Then
        FileCopy Application.CurrentProject.Path & "\" & FileCriteria, fnDeleteCreateFile
    End If
    
    Exit Function
    
Err_fnDeleteCreateFile:
    
    Select Case Err.Number
        Case 70, 49
            Resume Next
    End Select
    
End Function

Public Function fnDeleteIndex( _
    IndexName As String, _
    TableName As String)

On Error GoTo Hell

    Dim strSQL As String

    strSQL = "DROP INDEX " & IndexName & " " & _
    "ON " & TableName & ";"
    
'Debug.Print strSQL

    dbADO.Execute strSQL
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 3283, 3375, -2147467259
            Resume Next
        Case Else
            fnErrorHandler "Main / fnDeleteIndex"
            MsgBox strErrorMessage
            Resume Next
    End Select

End Function

Public Function fnDeleteRecord( _
    TableName As String, _
    CriteriaColumnName As String, _
    CriteriaValue)
    
    Dim strSQL As String

    strSQL = "DELETE FROM " & TableName & " " & _
        "WHERE " & CriteriaColumnName & " = " & CriteriaValue & ";"
        
    dbADO.Execute strSQL

End Function

Public Function fnDeleteTable(TableName As String)

    strSQL = "DROP TABLE " & TableName & ";"
    
    dbADO.Execute strSQL
    
End Function

Public Function fnDisable(obj)
    obj.Enabled = False
End Function

Public Function fnEditField(Record, FieldName, lngID)

    FieldName = lngID
    Record!Change = Now()
    Record.Update
    
End Function

Public Function fnEnable(obj)
    obj.Enabled = True
End Function

Public Function fnExitProgram()

On Error GoTo Err_fnExitProgram

    Dim mybar As Object
    
    Set mybar = CommandBars("Main")
    mybar.Enabled = False
    Set mybar = CommandBars("Default")
    mybar.Enabled = True

    Call fnBackup
        
    fnWriteINI fnCurrentMachineName, "User", fnGetUsername & " Offline"
        
    fnCloseADOConnection
    
    If blnMaintenance = False Then DoCmd.Quit acQuitPrompt
    
    Exit Function
    
Err_fnExitProgram:
    
    Select Case Err.Number
        Case 75, 3420, 91
            Resume Next
        Case Else
            fnErrorHandler "fnExitProgram"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnErrorHandler(strProcedure)

    Dim strFileName As String

    strFileName = Application.CurrentProject.Path & "\Error.txt"
    
    Open strFileName For Append As #1    ' Open file for output.
        
    Write #1, Format(Now(), "yyyymmdd hhmm") & " | " & Err.Number & " | " & Err.Description & _
        " | " & strProcedure
    
    Close #1    ' Close file.

End Function

Public Function fnGreenYellowRed(strTemp)

    lngColorIndexText = 1
    
    Select Case Val(strTemp)
        Case Is > 0
            lngColorIndexBackground = 35
        Case "0"
            lngColorIndexBackground = 6
        Case Is < 0
            lngColorIndexBackground = 3
        Case Else
            lngColorIndexBackground = 2
    End Select
    
End Function

Public Function fnGreenYellowRedPercent()

    lngColorIndexText = 1
    
    Select Case dblPAC
        Case Is < dblPercentYellowStart
            lngColorIndexBackground = 35
        Case Is >= dblPercentRedStart
            lngColorIndexBackground = 3
        Case Is >= dblPercentYellowStart
            lngColorIndexBackground = 6
        Case Else
            lngColorIndexBackground = 2
    End Select
    
End Function

Public Function fnLoadConstants()

On Error GoTo Err_fnLoadConstants

    strSQL = "SELECT * FROM buttons;"
    
'Debug.Print strSQL

    rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
    
    lngCounter = 1
    
    If Not rstTempADO.EOF Then
        
        rstTempADO.MoveFirst
        
        With Constant
            
            .Button(1) = rstTempADO!Button01
            .Button(2) = rstTempADO!Button02
            .Button(3) = rstTempADO!Button03
            .Button(4) = rstTempADO!Button04
            .Button(5) = rstTempADO!Button05
            .Button(6) = rstTempADO!Button06
            .Button(7) = rstTempADO!Button07
            .Button(8) = rstTempADO!Button08
            .Button(9) = rstTempADO!Button09
            .Button(10) = rstTempADO!Button10
        
        End With
        
    End If
    
    rstTempADO.Close
    
    strSQL = "SELECT * FROM constants;"
    
'Debug.Print strSQL

    rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
    
    lngCounter = 1
    
    If Not rstTempADO.EOF Then
        
        rstTempADO.MoveFirst
        
        With Constant
            
            .BackUpMonth = rstTempADO!backup_month
            .ColumnWidth(0, 0) = rstTempADO!column_width00
            .ColumnWidth(0, 1) = rstTempADO!column_width01
            .ColumnWidth(0, 2) = rstTempADO!column_width02
            .ColumnWidth(1, 0) = rstTempADO!column_width10
            .ColumnWidth(1, 1) = rstTempADO!column_width11
            .ColumnWidth(1, 2) = rstTempADO!column_width12
            .DocumentFolder = rstTempADO!document_folder
            .EventLine = rstTempADO!EventLine
            .FontSize(0) = rstTempADO!font_size0
            .FontSize(1) = rstTempADO!font_size1
            .PageScalling(0) = rstTempADO!page_scalling0
            .PageScalling(1) = rstTempADO!page_scalling1
            .RowHeight(0) = rstTempADO!row_height0
            .RowHeight(1) = rstTempADO!row_height1
            .RowHeight(2) = rstTempADO!row_height2
            .ViewZoom(0) = rstTempADO!view_zoom0
            .ViewZoom(1) = rstTempADO!view_zoom1
            
            'Folge = 3 is the default wing
            lngTemp = fnFindIDinArray(7, 5, 3)
            
            .Wing(0) = varTableArray(7, 0, lngTemp)
            
            .Wing(1) = varTableArray(7, 1, lngTemp)
        
        End With
        
    End If
    
    rstTempADO.Close
    
'    Numbers(0).MXWithhold(0) = fnReadINI("Defaults", "MXWithhold")

    With Constant
    
        fnImportTableIntoArray 2, Null, Null
        
        lngCounter = 1
        
        For lngTemp = 1 To varTableArray(2, 0, 0)
        
            If Not IsNull(varTableArray(2, 1, lngTemp)) Then
            
                .Squadrons(lngCounter, 0) = varTableArray(2, 1, lngTemp)
                .Squadrons(lngCounter, 1) = varTableArray(2, 2, lngTemp)
                .Squadrons(lngCounter, 2) = varTableArray(2, 3, lngTemp)
                .Squadrons(lngCounter, 3) = varTableArray(2, 4, lngTemp)
                .Squadrons(lngCounter, 4) = varTableArray(2, 5, lngTemp)
                .Squadrons(lngCounter, 5) = varTableArray(2, 0, lngTemp)
                
                lngCounter = lngCounter + 1
                
            End If
            
        Next lngTemp
        
        .Squadrons(0, 0) = lngCounter - 1
            
    End With
    
    Exit Function
    
Err_fnLoadConstants:
    
    Select Case Err.Number
        Case 91, 3420
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "fnLoadConstants"
            MsgBox strErrorMessage
    End Select

End Function

Public Function Ne(Value, ValueIfEmpty) As Variant
    Ne = IIf(IsEmpty(Value), ValueIfEmpty, Value)
End Function

Public Function fnInvisible(obj)
    obj.Visible = False
End Function

Public Function fnLoadconEvent()
    
    Erase conEvent
    
    lngCounter = 0
    
    For lngTemp = 1 To varTableArray(1, 0, 0)
    
        conEvent(lngCounter).Event = varTableArray(1, 1, lngTemp)
        conEvent(lngCounter).Explanation = varTableArray(1, 2, lngTemp)
        conEvent(lngCounter).ColorIndexBackground = varTableArray(1, 3, lngTemp)
        conEvent(lngCounter).ColorIndexText = varTableArray(1, 4, lngTemp)
        
        lngCounter = lngCounter + 1
        
    Next lngTemp
    
End Function

Public Function fnNumberDaysStartField() As Date

    Dim dteTempFirst As Date, dteTempLast As Date
    
    If DateValue(dteOriginalStart) < DateValue(dteFirst) Then
        dteTempFirst = dteFirst
    Else
        dteTempFirst = dteOriginalStart
    End If
    
    lngStartField = DateValue(dteTempFirst) - DateValue(dteFirst) + 1
    
    If DateValue(dteEnd) > DateValue(dteLast) Then
        dteTempLast = dteLast
    Else
        dteTempLast = dteEnd
    End If
    
    lngNumberDays = DateValue(dteTempLast) - DateValue(dteTempFirst) + 1
    
    fnNumberDaysStartField = dteTempLast
    
End Function

Public Function fnImport() As Boolean

On Error GoTo Err_fnImport

    fnImport = False
    
    Dim lngImportCounter As Long
    Dim strTableName As String
    
    lngImportCounter = 1
    
    strTableName = fnSetTables(lngImportCounter)
    
    Do Until strTableName = "DONE"
    
        fnImportInto strTableName
        
        lngImportCounter = lngImportCounter + 1
        
        strTableName = fnSetTables(lngImportCounter)
        
    Loop

    fnConfigureTables
        
    fnImport = True
    
    MsgBox "Data Imported!"
    
    Exit Function
    
Err_fnImport:
    
    Select Case Err.Number
        Case 70, 75, 3376
            Resume Next
        Case 53
            Exit Function
        Case Else
            fnErrorHandler "fnImport"
            MsgBox strErrorMessage
            Resume Next
    End Select
    
End Function

Private Function fnImportInto(strTable As String)

On Error GoTo Err_fnImportInto

    fnDeleteTable strTable

    strSQL = "SELECT * " & _
        "INTO " & strTable & " " & _
        "FROM " & strTable & " " & _
        "IN '" & strPath & "';"

    dbADO.Execute strSQL
    
    Exit Function
    
Err_fnImportInto:

    Select Case Err.Number
        Case 7874, -2147217865
            Resume Next
        Case Else
            fnErrorHandler "fnImportInto"
            MsgBox strErrorMessage
            Resume Next
    End Select
    
End Function

Public Function fnImportTableIntoArray(ArrayNumber, ExtraOne, ExtraTwo) As Long

    Select Case ArrayNumber
    Case 1
    
        strSQL = "SELECT event.*, color_event.colorbackground, color_event.colortext " & _
            "FROM event INNER JOIN color_event ON event.id = color_event.event;"
    
'Debug.Print strSQL

        rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
        
        lngCounter = 1
        
        If Not rstTempADO.EOF Then
            
            rstTempADO.MoveFirst
            
            Do
            
                varTableArray(1, 0, lngCounter) = rstTempADO!Id
                varTableArray(1, 1, lngCounter) = rstTempADO!kurz
                varTableArray(1, 2, lngCounter) = rstTempADO!lang
                varTableArray(1, 3, lngCounter) = rstTempADO!ColorBackground
                varTableArray(1, 4, lngCounter) = rstTempADO!ColorText
                varTableArray(1, 5, lngCounter) = rstTempADO!special
                varTableArray(1, 6, lngCounter) = rstTempADO!Folge
                varTableArray(1, 98, lngCounter) _
                    = fnFindColorNumber(varTableArray(1, 3, lngCounter))
                varTableArray(1, 99, lngCounter) _
                    = fnFindColorNumber(varTableArray(1, 4, lngCounter))
                varTableArray(1, 100, lngCounter) = False                   'Selected
                
                lngCounter = lngCounter + 1
                
                rstTempADO.MoveNext
                
            Loop Until rstTempADO.EOF
            
            varTableArray(1, 0, 0) = lngCounter - 1       'Array Count
        
        Else
            fnImportTableIntoArray = 0
        End If
        
        rstTempADO.Close
    
    Case 2
    
        strSQL = "SELECT squadrons.*, color_squadrons.colorbackground, color_squadrons.colortext " & _
            "FROM color_squadrons INNER JOIN squadrons ON color_squadrons.squadrons = squadrons.id " & _
            "ORDER BY squadrons.folge;"
    
'Debug.Print strSQL

        rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
        
        lngCounter = 1
        
        If Not rstTempADO.EOF Then
            
            rstTempADO.MoveFirst
            
            Do
        
                varTableArray(2, 0, lngCounter) = rstTempADO!Id
                varTableArray(2, 1, lngCounter) = rstTempADO!kurz
                varTableArray(2, 2, lngCounter) = rstTempADO!lang
                varTableArray(2, 3, lngCounter) = rstTempADO!ColorBackground
                varTableArray(2, 4, lngCounter) = rstTempADO!ColorText
                varTableArray(2, 5, lngCounter) = rstTempADO!special            'sqtype
                varTableArray(2, 98, lngCounter) _
                    = fnFindColorNumber(varTableArray(2, 3, lngCounter))
                varTableArray(2, 99, lngCounter) _
                    = fnFindColorNumber(varTableArray(2, 4, lngCounter))
                varTableArray(2, 100, lngCounter) = False                       'Selected
                
                lngCounter = lngCounter + 1
                
                rstTempADO.MoveNext
                
            Loop Until rstTempADO.EOF
            
            varTableArray(2, 0, 0) = lngCounter - 1       'Array Count
        
        Else
            fnImportTableIntoArray = 0
        End If
        
        rstTempADO.Close
    
    Case 3
        
        strSQL = "SELECT * FROM availability " & _
            "WHERE datum >= #" & ExtraOne & "# " & _
            "And datum <= #" & ExtraTwo & "# " & _
            "ORDER by datum;"
            
'Debug.Print strSQL
        
        rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
        
        strSQL = ""
    
        lngCounter = 1
        
        If Not rstTempADO.EOF Then
            
            rstTempADO.MoveFirst
            
            Do
            
                varTableArray(3, 0, lngCounter) = rstTempADO!Datum
                varTableArray(3, 1, lngCounter) = rstTempADO!TACCPossessedAircraft
                varTableArray(3, 2, lngCounter) = rstTempADO!TACCActive
                varTableArray(3, 3, lngCounter) = rstTempADO!TACCReserve
                varTableArray(3, 4, lngCounter) = rstTempADO!TACCDeployedCrews
                varTableArray(3, 5, lngCounter) = rstTempADO!aircraft
                varTableArray(3, 6, lngCounter) = rstTempADO!CCheck
                varTableArray(3, 7, lngCounter) = rstTempADO!TACCFlyableTraining
                varTableArray(3, 8, lngCounter) = rstTempADO!TACCMXTraining
                varTableArray(3, 9, lngCounter) = rstTempADO!MXWithhold
                varTableArray(3, 10, lngCounter) = rstTempADO!TACCDeployed
                varTableArray(3, 11, lngCounter) = rstTempADO!TACCTaskable
                varTableArray(3, 12, lngCounter) = rstTempADO!TACCMRCrews
                varTableArray(3, 13, lngCounter) = rstTempADO!LocalTrainingCrews
                varTableArray(3, 14, lngCounter) = rstTempADO!LocalTrainingAircraft
                varTableArray(3, 15, lngCounter) = rstTempADO!MXTraining
                varTableArray(3, 16, lngCounter) = conNoChange
                varTableArray(3, 17, lngCounter) = rstTempADO!reservecrewsactivated
                
                lngCounter = lngCounter + 1
                
                rstTempADO.MoveNext
                
            Loop Until rstTempADO.EOF
            
            varTableArray(3, 0, 0) = lngCounter - 1       'Array Count
            
            fnImportTableIntoArray = lngCounter - 1
        
        Else
            fnImportTableIntoArray = 0
        End If
        
        rstTempADO.Close
    
    Case 5
    
        strSQL = "SELECT * FROM colors;"
    
'Debug.Print strSQL
    
        rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
        
        strSQL = ""
    
        lngCounter = 1
        
        If Not rstTempADO.EOF Then
            
            rstTempADO.MoveFirst
            
            Do
            
                varTableArray(5, 0, lngCounter) = rstTempADO!ColorIndex
                varTableArray(5, 1, lngCounter) = rstTempADO!blue
                varTableArray(5, 2, lngCounter) = rstTempADO!green
                varTableArray(5, 3, lngCounter) = rstTempADO!red
                
                lngCounter = lngCounter + 1
                
                rstTempADO.MoveNext
                
            Loop Until rstTempADO.EOF
            
            varTableArray(5, 0, 0) = lngCounter - 1       'Array Count
            
            fnImportTableIntoArray = lngCounter - 1
        
        Else
            fnImportTableIntoArray = 0
        End If
        
        rstTempADO.Close
    
    Case 6
    
        Dim strTableName As String
        
        lngCounter = 1
        
        strTableName = fnSetTables(lngCounter)
        
        Do Until strTableName = "DONE"
        
            varTableArray(6, 0, lngCounter) = strTableName
            
            lngCounter = lngCounter + 1
            
            strTableName = fnSetTables(lngCounter)
        
        Loop
        
        varTableArray(6, 0, 0) = lngCounter - 1
    
    Case 7

        strSQL = "SELECT wing.*, color_wing.colorbackground, color_wing.colortext " & _
            "FROM color_wing INNER JOIN wing ON color_wing.wing = wing.id " & _
            "ORDER BY wing.folge;"
    
'Debug.Print strSQL

        rstTempADO.Open strSQL, dbADO, adOpenStatic, adLockReadOnly
    
        lngCounter = 1
        
        If Not rstTempADO.EOF Then
            
            rstTempADO.MoveFirst
            
            Do
            
                varTableArray(7, 0, lngCounter) = rstTempADO!Id
                varTableArray(7, 1, lngCounter) = rstTempADO!kurz
                varTableArray(7, 2, lngCounter) = rstTempADO!lang
                varTableArray(7, 3, lngCounter) = rstTempADO!ColorBackground
                varTableArray(7, 4, lngCounter) = rstTempADO!ColorText
                varTableArray(7, 5, lngCounter) = rstTempADO!Folge
                varTableArray(7, 98, lngCounter) _
                    = fnFindColorNumber(varTableArray(7, 3, lngCounter))
                varTableArray(7, 99, lngCounter) _
                    = fnFindColorNumber(varTableArray(7, 4, lngCounter))
                lngCounter = lngCounter + 1
                varTableArray(7, 100, lngCounter) = False                   'Selected
                
                rstTempADO.MoveNext
                
            Loop Until rstTempADO.EOF
            
            varTableArray(7, 0, 0) = lngCounter - 1       'Array Count
        
        Else
            fnImportTableIntoArray = 0
        End If
        
        rstTempADO.Close
        
    End Select
    
End Function

Public Function fnInsertInto(strTable)

On Error GoTo Hell

    strSQL = "SELECT " & strTable & ".* " & _
        "INTO " & strTable & " " & _
        "IN '" & strFile & "' " & _
        "FROM " & strTable & ";"

    dbADO.Execute strSQL
            
    Exit Function

Hell:

    Select Case Err.Number
        Case -2147217865
            Resume Next
        Case 91, 3704, 3420, 3240, -2147217843
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "fnInsertInto"
            MsgBox strErrorMessage
            Resume Next
    End Select

End Function

Public Function fnLock(obj)
    obj.Locked = True
End Function

Public Function fnMostRecentUndo(Record, UndoDate) As Boolean

    fnMostRecentUndo = True
    
    If DateValue(Record!Change) > DateValue(UndoDate) Then fnMostRecentUndo = False

End Function

Public Function fnQuoteDecode(TextToBeDecoded As String) As String

    TextToBeDecoded = Nz(TextToBeDecoded, "")
    
    fnQuoteDecode = Replace(TextToBeDecoded, Chr(187) & Chr(181) & Chr(171), "'")
    fnQuoteDecode = Replace(fnQuoteDecode, Chr(187) & Chr(181) & Chr(181) & Chr(171), Chr(34))

End Function

Public Function fnQuoteEncode(TextToBeEncoded) As String

    TextToBeEncoded = Nz(TextToBeEncoded, "")
    
    fnQuoteEncode = Replace(TextToBeEncoded, "'", Chr(187) & Chr(181) & Chr(171))
    fnQuoteEncode = Replace(fnQuoteEncode, Chr(34), Chr(187) & Chr(181) & Chr(181) & Chr(171))

End Function

Public Function fnReadINI(strSection As String, strEntry As String) As String
    
    Dim iLenBuf As Integer
    Dim X As Long
    Dim sDefault As String, sFileName As String, sRetBuf As String
    
    sDefault = ""
    sRetBuf$ = String$(256, 0)   '256 null characters
    iLenBuf% = Len(sRetBuf$)
    sFileName = Application.CurrentProject.Path & "\" & strINIFile
    
    X = GetPrivateProfileString(strSection, strEntry, _
        sDefault, sRetBuf$, iLenBuf%, sFileName)
        
    fnReadINI = Left$(sRetBuf$, X)

End Function

Public Function fnRecordCount(strTempSQL As String) As Long

On Error GoTo Hell

    rstTempADO.Open strTempSQL, dbADO, adOpenStatic, adLockReadOnly, adCmdText
    
    If Not rstTempADO.EOF Then
        rstTempADO.MoveLast
    End If
    
    fnRecordCount = rstTempADO.RecordCount
    
    rstTempADO.Close
    
    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3420, 3240
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnRecordCount"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnRenumberCriteria( _
    TableName As String, _
    CriteriaColumn As String, _
    CriteriaValue, _
    OrderColumnName As String) As Long
    
On Error GoTo Hell

    strSQL = "SELECT " & OrderColumnName & " AS ordnung " & _
        "FROM " & TableName & " " & _
        "WHERE (" & CriteriaColumn & " = " & CriteriaValue & ") " & _
        "ORDER BY " & OrderColumnName & ";"

    rstTempADO.Open strSQL, dbADO, adOpenDynamic, adLockOptimistic, adCmdText
    
    fnRenumberCriteria = rstTempADO.RecordCount
    
    If rstTempADO.EOF Then
        rstTempADO.Close
        Exit Function
    Else
        rstTempADO.MoveFirst
    End If
    
    lngCounter = 1
    
    Do
    
        rstTempADO!ordnung = lngCounter
        
        rstTempADO.Update
        
        rstTempADO.MoveNext
        
        lngCounter = lngCounter + 1
        
    Loop Until rstTempADO.EOF
    
    rstTempADO.Close

    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3240
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnRenumberCriteria"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnRenumberSimple( _
    TableName As String, _
    OrderColumnName As String) As Long

On Error GoTo Hell

    strSQL = "SELECT " & OrderColumnName & " AS ordnung FROM " & TableName & " " & _
        "ORDER BY " & OrderColumnName & ";"

    rstTempADO.Open strSQL, dbADO, adOpenDynamic, adLockOptimistic, adCmdText
    
    fnRenumberSimple = rstTempADO.RecordCount
    
    If rstTempADO.EOF Then
        rstTempADO.Close
        Exit Function
    Else
        rstTempADO.MoveFirst
    End If
    
    lngCounter = 1
    
    Do
    
        rstTempADO!ordnung = lngCounter
        
        rstTempADO.Update
        
        rstTempADO.MoveNext
        
        lngCounter = lngCounter + 1
        
    Loop Until rstTempADO.EOF
    
    rstTempADO.Close

    Exit Function
    
Hell:

    Select Case Err.Number
        Case 91, 3240
            fnSetDatabase
            Resume
        Case Else
            fnErrorHandler "Main / fnRenumberSimple"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnReverseGreenYellowRed(xls, strField, lngMax)
    
    With xls.Range(strField).Interior
    
        xls.Range(strField).Select
        
        Select Case xls.ActiveCell.Value
            Case Is > 0
                .ColorIndex = 35
            Case "0"
                .ColorIndex = 6
            Case Is < 0
                .ColorIndex = 3
            Case Else
                .ColorIndex = 0
        End Select
    
    End With

End Function

Public Function fnSelectSAMMIE() As String
    
    fnSelectSAMMIE = "SELECT Crew.CrewText, Crew.Crew, Priority.Priority AS priorityname, " & _
        "CFG.CFG AS cfgname, event.folge, Taskings.ID, taskings.event, " & _
        "Taskings.Start, taskings.sq1, taskings.sq2, taskings.sq3, taskings.sq4,  " & _
        "taskings.ende, Taskings.Comment, Taskings.Tail, Taskings.MSN, " & _
        "Taskings.wing, Taskings.FenceJet, Taskings.FrontLink, Taskings.BackLink, " & _
        "Taskings.Itinerary, Taskings.Sequence, Taskings.MSNSymbolPOSDEP, " & _
        "Taskings.MSNSymbolActive, Taskings.input1, Taskings.input2, Taskings.Change, " & _
        "Taskings.benutzer, Taskings.PPR, Taskings.input3, Taskings.input4, " & _
        "Taskings.input5, Taskings.input6, Taskings.input7, Taskings.Remark, " & _
        "Taskings.input8, Taskings.CANX, Taskings.Boom, Taskings.Drogue, Taskings.Pods, " & _
        "DateValue(NZ(Taskings.OriginalStart,taskings.start)) AS OriginalStart, " & _
        "Nz(taskings.OriginalEnd,taskings.ende) AS OriginalEnd, Taskings.CallSign, " & _
        "Taskings.MatrixRemark, Taskings.MC, Taskings.input10, Taskings.input9 " & _
        "FROM Priority INNER JOIN (Crew INNER JOIN (CFG INNER JOIN (Taskings " & _
        "INNER JOIN Event ON Taskings.event = Event.id) ON CFG.id = Taskings.cfg) " & _
        "ON Crew.id = Taskings.crew) ON Priority.id = Taskings.priority "

End Function

Public Function fnSelectTaskings(lngID) As String
    
    fnSelectTaskings = "SELECT * FROM Taskings " & _
        "WHERE id = " & Trim(Str(lngID)) & ";"

End Function

Public Function fnSelectInUseID(lngID) As String
    
    fnSelectInUseID = "SELECT * FROM InUse " & _
        "WHERE ID = " & Trim(Str(lngID)) & ";"

End Function

Public Function fnSelectInUseUsername(strUsername) As String
    
    fnSelectInUseUsername = "SELECT * FROM InUse " & _
        "WHERE benutzer =" & Chr(34) & strUsername & Chr(34) & ";"

End Function

Public Function fnSetDatabase() As Boolean

    fnSetDatabase = False

    strBenutzer = fnGetUsername
    strRootFolder = fnGetSpecialFolderA(CSIDL_PERSONAL)
        
    fnImportTableIntoArray 6, Null, Null
    
    fnOpenADOConnection
    
    If fnFindMaxID("patch") = 12 Then
        'V3.33
        fnPatch013
    End If
    
    If fnFindMaxID("patch") = 13 Then
        'V3.34
        fnPatch014
    End If
    
    lngNullValues.CFG = fnFindRecordID("SELECT * FROM cfg;", "kurz", "Null")
    lngNullValues.Crew = fnFindRecordID("SELECT * FROM crew;", "crew", "Null")
    
    fnImportTableIntoArray 1, Null, Null
    
    'Folge=1 is the default Event
    lngTemp = fnFindIDinArray(1, 6, 1)
    
    lngNullValues.Event = varTableArray(1, 0, lngTemp)
    
    lngNullValues.EventType = fnFindRecordID("SELECT * FROM eventtype;", "kurz", "Null")
    lngNullValues.Priority = fnFindRecordID("SELECT * FROM priority;", "priority", "Null")
    lngNullValues.SQType _
        = fnFindRecordID("SELECT * FROM sqtype;", "sqtype", "'" & "None" & "'")
    lngNullValues.Squadrons(0) = fnFindRecordID("SELECT * FROM squadrons;", "kurz", "Null")
    lngNullValues.Squadrons(1) = _
        fnFindRecordID("SELECT * FROM squadrons;", "kurz", "'" & "UA" & "'")
    
    fnImportTableIntoArray 7, Null, Null
    
    lngTemp = fnFindIDinArray(7, 1, Null)
    
    lngNullValues.Wing(0) = varTableArray(7, 0, lngTemp)
    
    'Folge = 2 is the Other Wing
    lngTemp = fnFindIDinArray(7, 3, 2)
    
    lngNullValues.Wing(1) = varTableArray(7, 0, lngTemp)

    fnLoadConstants
    
    fnLoadconEvent

    fnCreateDirectory strRootFolder, Constant.DocumentFolder

    strTemp = Left(Right(Application.CurrentProject.Name, 7), 3)
    
    strProgramVersion = "Version " & Left(strTemp, 1) & "." & Right(strTemp, 2)
        
'    strProgramVersion = "Version 3.50"
    
    fnWriteINI "Program", "Logon", Val(fnReadINI("Program", "Logon")) + 1

    fnWriteINI fnCurrentMachineName, "User", fnGetUsername & " Online " & strProgramVersion
    fnWriteINI fnCurrentMachineName, "Logon", Val(fnReadINI(fnCurrentMachineName, "Logon")) + 1
    
    fnSetDatabase = True
        
End Function

Private Function fnBackupInto(TableName)

    fnInsertInto TableName

End Function

Public Function fnChangeButtonColor(ctl, strID, lngColor)

    If strID <> "" Then
        ctl.ForeColor = lngColor
    End If

End Function

Public Function fnSetTables(TableCounter As Long) As String

    Select Case TableCounter
        Case 1
            fnSetTables = "availability"
        Case 2
            fnSetTables = "cfg"
        Case 3
            fnSetTables = "colors"
        Case 4
            fnSetTables = "constants"
        Case 5
            fnSetTables = "crew"
        Case 6
            fnSetTables = "dates"
        Case 7
            fnSetTables = "event"
        Case 8
            fnSetTables = "inuse"
        Case 9
            fnSetTables = "msn"
        Case 10
            fnSetTables = "priority"
        Case 11
            fnSetTables = "sqtype"
        Case 12
            fnSetTables = "taskings"
        Case 13
            fnSetTables = "eventtype"
        Case 14
            fnSetTables = "squadrons"
        Case 15
            fnSetTables = "defaults"
        Case 16
            fnSetTables = "patch"
        Case 17
            fnSetTables = "buttons"
        Case 18
            fnSetTables = "wing"
        Case 19
            fnSetTables = "color_event"
        Case 20
            fnSetTables = "color_squadrons"
        Case 21
            fnSetTables = "color_wing"
        Case 22
            fnSetTables = "DONE"
    End Select

End Function

Public Function fnToggleForeColor(ctl, lngColor)

    If ctl Then
        ctl.ForeColor = lngColor
    Else
        ctl.ForeColor = 0
    End If

End Function

Public Function fnUnLock(obj)
    obj.Locked = False
End Function

Public Function fnUnlockInUse()

On Error GoTo Err_fnUnlockInUse

    If blnSquadron Then Exit Function
    
    strSQL = "DELETE InUse.* FROM InUse;"
    
    dbADO.Execute strSQL
        
    Exit Function
    
Err_fnUnlockInUse:
    
    Select Case Err.Number
        Case 3078
            Exit Function
        Case Else
            fnErrorHandler "fnUnlockInUse"
            MsgBox strErrorMessage
    End Select

End Function

Public Function fnUpdateRecord( _
    TableName As String, _
    FieldName As String, _
    FromValue, _
    ToValue)
    
    Dim strSQL As String
    
    strSQL = "UPDATE " & TableName & " SET " & FieldName & " = " & ToValue & " " & _
        "WHERE " & FieldName & "=" & FromValue & ";"
        
    dbADO.Execute strSQL

End Function
    
Public Function fnUpDownButtonConfiguration( _
    Liste As ListBox, _
    DownButton As CommandButton, _
    UpButton As CommandButton, _
    Folge As Long, _
    ListCountAdjustment As Long, _
    TableCountAdjustment As Long, _
    RowsToIgnore As Long, _
    Form As Form)
    
    fnCheckSession Form.Name
    
    Liste.SetFocus
    
    If Folge = 0 Or Liste.ListCount - ListCountAdjustment <= 1 _
        Or Folge - TableCountAdjustment = RowsToIgnore Then
        UpButton.Enabled = False
        DownButton.Enabled = False
    ElseIf Folge - TableCountAdjustment - RowsToIgnore = 1 _
        And Liste.ListCount - ListCountAdjustment > 1 + RowsToIgnore Then
        UpButton.Enabled = False
        DownButton.Enabled = True
    ElseIf Liste.ListCount - ListCountAdjustment > 1 + RowsToIgnore _
        And Folge - TableCountAdjustment = Liste.ListCount - ListCountAdjustment Then
        UpButton.Enabled = True
        DownButton.Enabled = False
    Else
        UpButton.Enabled = True
        DownButton.Enabled = True
    End If

End Function

Public Function fnVisible(obj)
    obj.Visible = True
End Function

Public Function fnWriteINI(strSection, strEntry$, strData$)

    Dim sFileName As String
    
    sFileName$ = Application.CurrentProject.Path & "\" & strINIFile
    
    WritePrivateProfileString strSection, strEntry$, strData$, sFileName$

End Function"

Open in new window

Gillian BennettAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
That is a MASSIVE amount of code, and I'm not going to look through it to find the right line. Can you let us know which line errors out?
0
Gillian BennettAuthor Commented:
Line 1370 is where it errors out. Thanks.
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
At first glance, I'd think that the "strField" does not reference a field in the recordset. Without knowing the values you're passing in for strRecord, strField, etc, however, that's hard to say.

Can you set a breakpoint in the code (line 1363, perhaps) and then show what the values of your variables are?

Note too that it seems a bit redundant to open a recordset and then filter it. You could instead just open a filtered recordset:

 rstTablesADO.Open strRecord & " WHERE " & strField & "=" & LookFor, dbADO, adOpenStatic, adLockReadOnly
If Not (rstTablesADO.EOF and rstTableADO.BOF) Then
  '/ you found a record
End If

Of course, your code (or mine above) would fail if the value you're searching for is a Text value, or a Date value. Your code doesn't seem to check for that.
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Jason clarkDBA FreelancerCommented:
This error is coming because somewhere you used a field name in your code which doesn't exist in the recordset. A common error it may be  some misspelling (leaving out a space, or using an underscore instead of a space when the field name in the table actually has a space, or may be other.) Go through the code once.
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Hi Jason - that's essentially what I said in my comment 2 days prior to yours.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Helen FeddemaCommented:
For the search string, I recommend using a strSearch variable, which you can then display in the Immediate Window for purposes of debugging.  strSearch = strField & " = " & LookFor

Then Debug.Print "Search string: " & strSearch

One possible cause of errors in search string is data typing -- you may have to do some data type conversion to yield a valid string.
0
Jason clarkDBA FreelancerCommented:
No response from author
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.