Option Explicit
Option Compare Text
Public wksWorkSpace As Workspace
Public dbProfile As Database
Public dbStorage As Database
Public FSO As FileSystemObject
Public stSQL As String
Public inType As Integer
 
Private Sub cmdGo_Click()
    Dim rsSet As Recordset
    Dim stLine As String
    
    lstItems.Clear
    If txtSQLAddOn.Text <> "" Then
        Select Case inType
            Case Is < 4
                stSQL = stSQL & " AND " & txtSQLAddOn.Text & " ORDER BY Name"
            Case 4, 5, 6, 9
                stSQL = stSQL & " " & txtSQLAddOn.Text & " ORDER BY Name"
            Case 7
                stSQL = stSQL & " " & txtSQLAddOn.Text & " ORDER BY Index"
            Case 10
                stSQL = stSQL & " " & txtSQLAddOn.Text & " ORDER BY GName"
        End Select
    Else
        Select Case inType
            Case 0, 1, 2, 3, 4, 5, 6, 9
                stSQL = stSQL & " ORDER BY Name"
            Case 7
                stSQL = stSQL & " ORDER BY Index"
            Case 10
                stSQL = stSQL & " ORDER BY GName"
        End Select
    End If
    Set rsSet = dbProfile.OpenRecordset(stSQL)             'This line gives the error

    If rsSet.BOF = False Or rsSet.EOF = False Then
        rsSet.MoveFirst
        Do While rsSet.EOF = False
            Select Case inType
                Case 0, 1, 2, 3
                    stLine = rsSet!Name & ", " & rsSet!Cost
                    If rsSet!UpTo <> "" Then stLine = stLine & ", UpTo(" & rsSet!UpTo & ")"
                    If rsSet!Mods <> "" Then stLine = stLine & ", Mods(" & rsSet!Mods & ")"
                    If rsSet!Gives <> "" Then stLine = stLine & ", Gives(" & rsSet!Gives & ")"
                    If rsSet!Needs <> "" Then stLine = stLine & ", Needs(" & rsSet!Needs & ")"
                    If rsSet!Notes <> "" Then stLine = stLine & ", Notes(" & rsSet!Notes & ")"
                    If rsSet!Page <> "" Then stLine = stLine & ", Page(" & rsSet!Page & ")"
                Case 4
                    stLine = rsSet!Name & ", " & rsSet!Type
                    If rsSet!UpTo <> "" Then stLine = stLine & ", UpTo(" & rsSet!UpTo & ")"
                    If rsSet!Stat <> "" Then stLine = stLine & ", Stat(" & rsSet!Stat & ")"
                    If rsSet!Default <> "" Then stLine = stLine & ", Default(" & rsSet!Default & ")"
                    If rsSet!Gives <> "" Then stLine = stLine & ", Gives(" & rsSet!Gives & ")"
                    If rsSet!Mods <> "" Then stLine = stLine & ", Mods(" & rsSet!Mods & ")"
                    If rsSet!Needs <> "" Then stLine = stLine & ", Needs(" & rsSet!Needs & ")"
                    If rsSet!Notes <> "" Then stLine = stLine & ", Notes(" & rsSet!Notes & ")"
                    If rsSet!Page <> "" Then stLine = stLine & ", Page(" & rsSet!Page & ")"
                Case 5
                    stLine = rsSet!Name & ", " & rsSet!Type
                    If rsSet!CastingCost <> "" Then stLine = stLine & ", CastingCost(" & rsSet!CastingCost & ")"
                    If rsSet!Needs <> "" Then stLine = stLine & ", Needs(" & rsSet!Needs & ")"
                    If rsSet!Duration <> "" Then stLine = stLine & ", Duration(" & rsSet!Duration & ")"
                    If rsSet!Time <> "" Then stLine = stLine & ", Time(" & rsSet!Time & ")"
                    If rsSet!Notes <> "" Then stLine = stLine & ", Notes(" & rsSet!Notes & ")"
                    If rsSet!Page <> "" Then stLine = stLine & ", Page(" & rsSet!Page & ")"
                Case 6
                    stLine = rsSet!Name
                    If rsSet!Description <> "" Then stLine = stLine & ", Description(" & rsSet!Description & ")"
                    stLine = stLine & ", Race(" & rsSet!Race & ")"
                    stLine = stLine & ", New(" & rsSet!New & ")"
                Case 7
                    stLine = "If " & rsSet!Stat & rsSet!Test & rsSet!Score & " Then " & rsSet!Bonus & " " & rsSet!ApSec & ":" & rsSet!ApName
                Case 9
                    stLine = rsSet!Name
                    If rsSet!BaseValue <> "" Then stLine = stLine & ", BaseValue(" & rsSet!BaseValue & ")"
                    If rsSet!Step <> "" Then stLine = stLine & ", Step(" & rsSet!Step & ")"
                    If rsSet!Down <> "" Then stLine = stLine & ", Down(" & rsSet!Down & ")"
                    If rsSet!MinScore <> "" Then stLine = stLine & ", MinScore(" & rsSet!MinScore & ")"
                    If rsSet!Up <> "" Then stLine = stLine & ", Up(" & rsSet!Up & ")"
                    If rsSet!MaxScore <> "" Then stLine = stLine & ", MaxScore(" & rsSet!MaxScore & ")"
                    stLine = stLine & ", Round(" & rsSet!Round & ")"
                    If rsSet!Symbol <> "" Then stLine = stLine & ", Symbol(" & rsSet!Symbol & ")"
                    stLine = stLine & ", Display(" & rsSet!Display & ")"
                    If rsSet!DoubleInPlay <> "" Then stLine = stLine & ", DoubleInPlay(" & rsSet!DoubleInPlay & ")"
                Case 10
                    stLine = "GroupName(" & rsSet!GName & "), " & rsSet!Tag & ":" & rsSet!Subject
            End Select
            lstItems.AddItem stLine
            rsSet.MoveNext
        Loop
    End If
End Sub
 
Private Sub Form_Load()
    Dim tblDef As TableDef
    Dim Indx As Index
    Dim relMakRel As Relation
    stSQL = "SELECT * FROM ADPQ WHERE Section = 'ADS'"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set wksWorkSpace = CreateWorkspace("", "admin", "", dbUseJet)
    Set dbProfile = wksWorkSpace.OpenDatabase(App.Path & "\profile.mdb", True, False)
    If FSO.FileExists(App.Path & "\storage.mdb") Then
        Set dbStorage = wksWorkSpace.OpenDatabase(App.Path & "\storage.mdb", True, False)
    Else
        Set dbStorage = wksWorkSpace.CreateDatabase(App.Path & "\storage.mdb", dbLangGeneral)
        'Table Replace

        Set tblDef = dbStorage.CreateTableDef("Replace")
        With tblDef
            .Fields.Append .CreateField("Type", dbText, 10)
            .Fields.Append .CreateField("DelName", dbMemo)
            Set Indx = .CreateIndex("RepIndx")
            Indx.Fields.Append Indx.CreateField("DelName", dbMemo)
            Indx.Unique = True
            Indx.Primary = True
            tblDef.Indexes.Append Indx
        End With
        dbStorage.TableDefs.Append tblDef
        'Table With

        Set tblDef = dbStorage.CreateTableDef("With")
        With tblDef
            .Fields.Append .CreateField("Index", dbLong)
            .Fields("Index").Attributes = dbAutoIncrField
            .Fields.Append .CreateField("DelName", dbMemo)
            .Fields.Append .CreateField("AddName", dbMemo)
            Set Indx = .CreateIndex("WithIndx")
            Indx.Fields.Append Indx.CreateField("DelName", dbMemo)
            Indx.Fields.Append Indx.CreateField("AddName", dbMemo)
            Indx.Unique = True
            Indx.Primary = True
            tblDef.Indexes.Append Indx
        End With
        dbStorage.TableDefs.Append tblDef
        Set relMakRel = dbStorage.CreateRelation("ReplaceToWith", "Replace", "With", dbRelationDeleteCascade)
        relMakRel.Fields.Append relMakRel.CreateField("DelName", dbMemo)
        relMakRel.Fields!DelName.ForeignName = "DelName"
        dbStorage.Relations.Append relMakRel
        'Next Table
        
        dbStorage.Close
        Set dbStorage = wksWorkSpace.OpenDatabase(App.Path & "\storage.mdb", True, False)
    End If
End Sub
 
Private Sub optType_Click(Index As Integer)
    Select Case Index
        Case Is < 4
            stSQL = "SELECT * FROM ADPQ WHERE Section = '" & optType(Index).Caption & "'"
        Case Else
            stSQL = "SELECT * FROM " & optType(Index).Caption
    End Select
    txtSQLAddOn.Text = ""
    inType = Index
End Sub