Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mquery/mquery.frm

Visual Basic Form | 1995-05-02 | 26.5 KB | 900 lines

VERSION 2.00
Begin Form fQuery
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Query Builder"
   ClientHeight    =   5730
   ClientLeft      =   1425
   ClientTop       =   2145
   ClientWidth     =   9195
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   6135
   Icon            =   MQUERY.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   1365
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5709.895
   ScaleMode       =   0  'User
   ScaleWidth      =   9625.69
   Top             =   1800
   Width           =   9315
   Begin SSPanel PnlHelp
      Alignment       =   1  'Left Justify - MIDDLE
      AutoSize        =   1  'AutoSize Panel Width To Caption
      BackColor       =   &H0000FFFF&
      BevelOuter      =   0  'None
      BorderWidth     =   1
      Font3D          =   0  'None
      ForeColor       =   &H00FF0000&
      Height          =   315
      Left            =   3705
      TabIndex        =   32
      Top             =   1320
      Visible         =   0   'False
      Width           =   1965
   End
   Begin ListBox cColOrder
      BackColor       =   &H00C0C0C0&
      Height          =   420
      Left            =   6000
      TabIndex        =   31
      Top             =   1590
      Width           =   3075
   End
   Begin CommandButton RunSaveQryButton
      Caption         =   "&Load Query"
      Height          =   375
      Left            =   4440
      TabIndex        =   0
      Top             =   4815
      Width           =   1290
   End
   Begin CommandButton ExecSqlButton
      Caption         =   "&ExecSQL"
      Height          =   375
      Left            =   5835
      TabIndex        =   1
      Top             =   4815
      Width           =   960
   End
   Begin SSPanel Panel3D1
      Align           =   2  'Align Bottom
      Alignment       =   1  'Left Justify - MIDDLE
      BackColor       =   &H0000FFFF&
      BevelInner      =   1  'Inset
      Font3D          =   0  'None
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00FF0000&
      Height          =   435
      Left            =   0
      TabIndex        =   29
      Top             =   5295
      Width           =   9195
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Display"
      Height          =   495
      Left            =   120
      TabIndex        =   28
      Top             =   4740
      Width           =   3075
      Begin OptionButton Option1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Grid"
         Height          =   195
         Index           =   0
         Left            =   2100
         TabIndex        =   19
         Top             =   180
         Value           =   -1  'True
         Width           =   915
      End
      Begin OptionButton Option1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Record"
         Height          =   195
         Index           =   1
         Left            =   840
         TabIndex        =   18
         Top             =   180
         Width           =   975
      End
   End
   Begin PictureBox ExpressionBox
      BackColor       =   &H00C0C0C0&
      Height          =   1095
      Left            =   120
      ScaleHeight     =   1065
      ScaleWidth      =   9705
      TabIndex        =   24
      Tag             =   "OL"
      Top             =   240
      Width           =   9735
      Begin CommandButton GetValuesButton
         Caption         =   "List Possible &Values"
         Height          =   252
         Left            =   5955
         TabIndex        =   17
         Top             =   720
         Width           =   2292
      End
      Begin ComboBox cValue
         BackColor       =   &H00C0C0C0&
         Height          =   300
         Left            =   5580
         Sorted          =   -1  'True
         TabIndex        =   14
         Text            =   "cValue"
         Top             =   375
         Width           =   3330
      End
      Begin ComboBox cOperator
         BackColor       =   &H00C0C0C0&
         Height          =   300
         Left            =   4320
         Style           =   2  'Dropdown List
         TabIndex        =   13
         Top             =   360
         Width           =   1095
      End
      Begin ComboBox cField
         BackColor       =   &H00C0C0C0&
         Height          =   300
         Left            =   120
         Style           =   2  'Dropdown List
         TabIndex        =   12
         Top             =   360
         Width           =   4095
      End
      Begin CommandButton ORButton
         Caption         =   "&Or into Criteria"
         Height          =   252
         Left            =   2040
         TabIndex        =   16
         Top             =   720
         Width           =   1812
      End
      Begin CommandButton ANDButton
         Caption         =   "&And into Criteria"
         Height          =   252
         Left            =   120
         TabIndex        =   15
         Tag             =   "Are you paying attention!!!!"
         Top             =   720
         Width           =   1812
      End
      Begin Label OperatorLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Operator:"
         Height          =   195
         Left            =   4320
         TabIndex        =   27
         Top             =   120
         Width           =   975
      End
      Begin Label ValueLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Value:"
         Height          =   195
         Left            =   5520
         TabIndex        =   26
         Top             =   120
         Width           =   1455
      End
      Begin Label FieldNameLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Field Name:"
         Height          =   192
         Left            =   120
         TabIndex        =   25
         Top             =   120
         Width           =   1332
      End
   End
   Begin CommandButton JoinButton
      Caption         =   "Set Table &Joins"
      Height          =   255
      Left            =   6240
      TabIndex        =   10
      Top             =   2670
      Width           =   2535
   End
   Begin ListBox cJoinFields
      BackColor       =   &H00C0C0C0&
      Height          =   420
      Left            =   6000
      TabIndex        =   11
      Tag             =   "OL"
      Top             =   2970
      Width           =   3135
   End
   Begin ComboBox cOrderByField
      BackColor       =   &H00C0C0C0&
      Height          =   300
      Left            =   6000
      Style           =   2  'Dropdown List
      TabIndex        =   9
      Tag             =   "OL"
      Top             =   2310
      Width           =   3135
   End
   Begin ListBox cTableList
      BackColor       =   &H00C0C0C0&
      Height          =   1590
      Left            =   120
      MultiSelect     =   1  'Simple
      TabIndex        =   6
      Tag             =   "OL"
      Top             =   1680
      Width           =   2175
   End
   Begin ListBox cShowFields
      BackColor       =   &H00C0C0C0&
      Height          =   1590
      Left            =   2415
      MultiSelect     =   1  'Simple
      TabIndex        =   7
      Tag             =   "OL"
      Top             =   1650
      Width           =   3510
   End
   Begin CommandButton CloseButton
      Cancel          =   -1  'True
      Caption         =   "&Exit"
      Height          =   375
      Left            =   8070
      TabIndex        =   3
      Top             =   4815
      Width           =   915
   End
   Begin CommandButton RunQueryButton
      Caption         =   "&Run Query"
      Height          =   375
      Left            =   3300
      TabIndex        =   4
      Top             =   4815
      Width           =   1035
   End
   Begin CommandButton ClearButton
      Caption         =   "R&eset"
      Height          =   375
      Left            =   6900
      TabIndex        =   2
      Top             =   4815
      Width           =   1095
   End
   Begin TextBox cCriteria
      BackColor       =   &H00C0C0C0&
      Height          =   1215
      Left            =   45
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Tag             =   "OL"
      Top             =   3480
      Width           =   9105
   End
   Begin Label lFilter
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Select Filter"
      Height          =   195
      Left            =   120
      TabIndex        =   30
      Top             =   0
      Width           =   1035
   End
   Begin Label OrberByFieldLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Order By Field:"
      Height          =   195
      Left            =   6000
      TabIndex        =   8
      Top             =   2070
      Width           =   2055
   End
   Begin Label ColOrderLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Column Order:"
      Height          =   195
      Left            =   6000
      TabIndex        =   23
      Top             =   1380
      Width           =   2055
   End
   Begin Label TableListLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Select Tables:"
      Height          =   195
      Left            =   120
      TabIndex        =   22
      Top             =   1440
      Width           =   1455
   End
   Begin Label ShowFieldsLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Select Fields to Show:"
      Height          =   195
      Left            =   2400
      TabIndex        =   21
      Top             =   1440
      Width           =   2055
   End
   Begin Label CriteriaLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Criteria:"
      Height          =   180
      Left            =   120
      TabIndex        =   20
      Top             =   3270
      Width           =   1335
   End
Sub ANDButton_Click ()
  ShowHelp ANDButton, 0, 0
  Dim f As field
  Dim ns As Integer
  Dim nsflds As String
  Dim nt As Integer
  Dim ntflds As String
  If cField = "" Then Exit Sub
    If UCase(Left(cField, 4)) = "DBO." Then
    nsflds = Mid(cField, 5, Len(cField))
    Else
    nsflds = cField
    End If
  Set f = gCurrentDB.TableDefs(stSTF((nsflds), 0)).Fields(stSTF((nsflds), 1))
 If cCriteria <> "" Then
    cCriteria = cCriteria + Chr(13) + Chr(10) + "And "
  End If
  If f.Type = FT_STRING Or f.Type = FT_MEMO Then
     ns = InStr(1, cField, ".")
     nsflds = Mid(cField, ns + 1, Len(cField))
     ntflds = Left(cField, ns - 1)
        nt = InStr(1, ntflds, " ")
        If nt > 0 Then
        ntflds = "[" + ntflds + "]"
        nsflds = ntflds + "." + "[" + nsflds + "]"
        Else
        nsflds = "[" + nsflds + "]"
        nsflds = Left(cField, ns) + nsflds
        End If
      nt = InStr(1, cValue, "'")
      If nt > 0 Then
      ntflds = Chr(34) + cValue + Chr(34)
     cCriteria = cCriteria + "((" + nsflds + " " + cOperator + " " + ntflds + "))"
     Else
    cCriteria = cCriteria + nsflds + " " + cOperator + " '" + cValue + "'"
     End If
  Else
     'If f.Type = FT_DATETIME Then
         ns = InStr(1, cField, ".")
         nsflds = Mid(cField, ns + 1, Len(cField))
         ntflds = Left(cField, ns - 1)
         nt = InStr(1, ntflds, " ")
        If nt > 0 Then
        ntflds = "[" + ntflds + "]"
        nsflds = ntflds + "." + "[" + nsflds + "]"
        Else
        nsflds = "[" + nsflds + "]"
        nsflds = Left(cField, ns) + nsflds
        End If
        If f.Type = FT_DATETIME Then
        cValue = "#" + cValue + "#"
        End If
    'End If
    cCriteria = cCriteria + nsflds + " " + cOperator + " " + cValue
  End If
  cField.SetFocus
End Sub
Sub ANDButton_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    ShowHelp ANDButton, x, y
End Sub
Sub cCriteria_GotFocus ()
ExecSqlButton.Enabled = True
RunSaveQryButton.Enabled = False
End Sub
Sub cField_Click ()
  cValue.Clear
End Sub
Sub ClearButton_Click ()
resetdefault
End Sub
Sub CloseButton_Click ()
End Sub
Sub cShowFields_Click ()
If cShowfields.ListCount = 0 Then
CriteriaLabel.Caption = "SQL Statement"
Exit Sub
End If
' which item was clicked on
' is it already in the colorder box if so remove it
For j% = 0 To cColOrder.ListCount - 1
If cColOrder.List(j%) = cShowfields.List(cShowfields.ListIndex) Then
cColOrder.RemoveItem (j%)
removed% = True
Exit For
End If
Next j%
If Not removed% Then ' must be an add not a remove
addit$ = cShowfields.List(cShowfields.ListIndex)
cColOrder.AddItem addit$
removed% = False
End If
CriteriaLabel.Caption = "Criteria:"
For h% = 0 To cShowfields.ListCount - 1
If cShowfields.Selected(h%) Then
    RunQueryButton.Enabled = True
    ExecSqlButton.Enabled = False
   If RunSaveQryButton.Caption = "&Load Query" Then
    RunSaveQryButton.Enabled = False
   End If
Exit Sub
End If
RunQueryButton.Enabled = False
ExecSqlButton.Enabled = True
End Sub
Sub cTableList_Click ()
    On Error GoTo errtrap
    If deselect > 0 Then
    deselect = 0
    Exit Sub
    End If
  Dim I As Integer, ii As Integer
  Dim t As TableDef
  Dim q As QueryDef
  Dim st As String
  Dim trap As Integer
  cCriteria.Text = ""
  cField.Clear
  cShowfields.Clear
  cColOrder.Clear
  cOrderByField.Clear
  cValue.Clear
  If RunQueryButton.Enabled = True Then
      RunSaveQryButton.Enabled = True
      RunQueryButton.Enabled = False
      ExecSqlButton.Enabled = True
      CriteriaLabel.Caption = "SQL Statement"
  End If
  gStoredFlag = False
  cOrderByField.AddItem "(none)"
  For ii = 0 To cTableList.ListCount - 1
    If cTableList.Selected(ii) Then
    'RunQueryButton.Enabled = True
      Set t = gCurrentDB.TableDefs(cTableList.List(ii))
      For I = 0 To t.Fields.Count - 1
    st = cTableList.List(ii) + "." + t.Fields(I).Name
        If UCase(Left(st, 4)) = "DBO." Then
        st = Mid(st, 5, Len(st))
        End If
    cField.AddItem st
    cShowfields.AddItem st
    'cColOrder.AddItem st
    cOrderByField.AddItem st
      Next
    End If
  Next
  If cField.List(0) <> "" Then
    cField.ListIndex = 0
    'cColOrder.ListIndex = 0
    cOrderByField.ListIndex = 0
  End If
exitit:
Exit Sub
errtrap:
  trap = MsgBox("Cannot use this file", 0, "Query")
  Resume exitit
End Sub
Sub ExecSqlButton_Click ()
ExecSql
If Not gfFROMSQL And Not gStoredFlag Then
 MsgBox "No SQL Statement to Execute!", 48
 NoCritflag = False
End If
End Sub
Sub Form_Load ()
   fQuery.Left = (screen.Width - fQuery.Width) / 2
   fQuery.Top = (screen.Height - fQuery.Height) / 2
   On Local Error GoTo FLErr
   Dim ds As DynaSet
   Dim I As Integer
   Dim t As TableDef
   Dim q As QueryDef
   'Clear listbox
   cCriteria = ""
   'Fill the Operator combo
   cOperator.AddItem "="
   cOperator.AddItem "<>"
   cOperator.AddItem ">"
   cOperator.AddItem ">="
   cOperator.AddItem "<"
   cOperator.AddItem "<="
   cOperator.AddItem "Like"
   cOperator.ListIndex = 0
   cTableList.ListIndex = 0
   CriteriaLabel.Caption = "SQL Statement"
   RunSaveQryButton.Caption = "&Load Query"
   RunQueryButton.Enabled = False
   cValue = ""
  GoTo FLEnd
FLErr:
  ShowError
  Resume FLEnd
FLEnd:
Me.Show
End Sub
Sub Form_Paint ()
  Outlines Me
  PicOutlines ExpressionBox, cField
  PicOutlines ExpressionBox, cOperator
  PicOutlines ExpressionBox, cValue
End Sub
Sub Form_Resize ()
  On Error Resume Next
  If WindowState <> 1 Then
    Height = 6050
    'Width = 7224
    Width = 9315'250
  End If
End Sub
Sub GetValuesButton_Click ()
  Dim ds As DynaSet
  Dim dsString As String
  Dim ns As Integer
  Dim fldn As String
  Dim nv As String
  cValue.Clear
    ' search for sql .dbo and strip
    If UCase(Left(cField, 4)) = "DBO." Then
    fldn = Mid(cField, 5, Len(cField))
    ns = InStr(1, fldn, ".")
    nv = Left(fldn, ns - 1)
    fldn = "[" + Mid(fldn, ns + 1, Len(fldn)) + "]"
    fldn = nv + "." + fldn
    dsString = "select Distinct " + fldn + " from "
    Else
    ns = InStr(1, cField, ".")
    fldn = Mid(cField, ns + 1, Len(cField))
    nv = Left(cField, ns - 1)
    nt% = InStr(1, nv, " ")
    If nt% > 0 Then
     fldn = "[" + nv + "]" + "." + "[" + fldn + "]"
    Else
    fldn = Left(cField, ns) + "[" + fldn + "]"
    End If
    dsString = "select Distinct " + fldn + " from "
    End If
  On Error GoTo GVErr
  MsgBar "Getting Possible Values", True
  SetHourGlass Me
  Set ds = gCurrentDB.CreateDynaset(dsString + stSTF((fldn), 0))
  Do While ds.EOF = False
    If Trim(ds(0)) <> "" Then
      cValue.AddItem ds(0).Value
    End If
    ds.MoveNext
  Loop
  ds.Close
  cValue = cValue.List(0)
  cValue.SetFocus
  GoTo GVEnd
GVErr:
  cValue = ""
  Resume GVEnd
GVEnd:
  ResetMouse Me
  MsgBar "", False
End Sub
Sub JoinButton_Click ()
  Dim I As Integer
  Dim c As Integer
  For I = 0 To cTableList.ListCount - 1
    If cTableList.Selected(I) = True Then
      c = c + 1
    End If
  Next
  If c < 2 Then
    Beep
    MsgBox "You Must Have at Least 2 Tables Selected!", 48
  Else
    MsgBar "Choose Joins", False
    fJoin.Show MODAL
    MsgBar "", False
  End If
End Sub
Sub ORButton_Click ()
  Dim f As field
  Dim ns As Integer
  Dim nsflds As String
  Dim nt As Integer
  Dim ntflds As String
  If cField = "" Then Exit Sub
    If UCase(Left(cField, 4)) = "DBO." Then
    nsflds = Mid(cField, 5, Len(cField))
    Else
    nsflds = cField
    End If
  Set f = gCurrentDB.TableDefs(stSTF((cField), 0)).Fields(stSTF((cField), 1))
  If cCriteria <> "" Then
    cCriteria = cCriteria + Chr(13) + Chr(10) + " Or "
  End If
  If f.Type = FT_STRING Or f.Type = FT_MEMO Then
     ns = InStr(1, cField, ".")
     nsflds = Mid(cField, ns + 1, Len(cField))
     ntflds = Left(cField, ns - 1)
        nt = InStr(1, ntflds, " ")
        If nt > 0 Then
        ntflds = "[" + ntflds + "]"
        nsflds = ntflds + "." + "[" + nsflds + "]"
        Else
        nsflds = "[" + nsflds + "]"
        nsflds = Left(cField, ns) + nsflds
        End If
    cCriteria = cCriteria + nsflds + " " + cOperator + " '" + cValue + "'"
  Else
     If f.Type = FT_DATETIME Then
         ns = InStr(1, cField, ".")
         nsflds = Mid(cField, ns + 1, Len(cField))
         ntflds = Left(cField, ns - 1)
         nt = InStr(1, ntflds, " ")
        If nt > 0 Then
        ntflds = "[" + ntflds + "]"
        nsflds = ntflds + "." + "[" + nsflds + "]"
        Else
        nsflds = "[" + nsflds + "]"
        nsflds = Left(cField, ns) + nsflds
        End If
        cValue = "#" + cValue + "#"
    End If
    cCriteria = cCriteria + nsflds + " " + cOperator + " " + cValue
  End If
  cField.SetFocus
End Sub
Sub RunQueryButton_Click ()
  On Error GoTo OKErr
     Dim ds As DynaSet
     Dim fs As String
     Dim ts As String
     Dim I As Integer
     Dim ns As Integer
     Dim nsflds As String
     Dim nt As Integer
     Dim ntflds As String
     Dim listnu As Integer
     Dim joins As String
     joins = ""
     listnu = 0
    MsgBar "Building Query", True
       For I% = 0 To cTableList.ListCount - 1
    If cTableList.Selected(I%) Then
    listnu = listnu + 1
    End If
      Next I
        If listnu > 1 And cJoinFields.ListCount = 0 Then
        MsgBox "You Must Have a Join for more than 1 Table Selected!", 48
        Exit Sub
        End If
     'check for join condition
     If cJoinFields.ListCount > 0 Then
       For I = 0 To cJoinFields.ListCount - 1
     joins = joins + cJoinFields.List(I) + ","
       Next
       'get rid of last ,
       joins = " " + Left(joins, Len(joins) - 1)
       End If
     If cCriteria <> "" Then
      StWhere$ = "AND " + LTrim(cCriteria)
       'strip CRLFs
       For I = 1 To Len(StWhere$)
     If Mid(StWhere$, I, 1) = Chr$(13) Then
       stTmp$ = stTmp$ + " "
     ElseIf Mid(StWhere$, I, 1) = Chr$(10) Then
       'do nothing
     Else
       stTmp$ = stTmp$ + Mid(StWhere$, I, 1)
     End If
       Next
       StWhere$ = stTmp$
       StWhere$ = RTrim(StWhere$)

       'Add parens to stWhere$
    stTmpWhere$ = StWhere$
      stTmp$ = stGetToken(stTmpWhere$, " ")
      If fMatchParen% = False And UCase(stTmp$) = "AND" Then
        stNewWhere$ = stNewWhere$ + stTmp$ + " ("
        fMatchParen% = True
      ElseIf fMatchParen% = True And UCase(stTmp$) = "AND" Then
        stNewWhere$ = stNewWhere$ + ") " + stTmp$ + " ("
        'fMatchParen% = False
      Else
        If UCase(stTmp$) = "OR" Or UCase(stTmp$) = "IN" Or UCase(stTmp$) = "LIKE" Then
          stNewWhere$ = stNewWhere$ + " " + stTmp$ + " "
        Else
          stNewWhere$ = stNewWhere$ + stTmp$
        End If
      End If
    Loop Until stTmpWhere$ = ""
    StWhere$ = stNewWhere$ + ")"
       'Build DynaSet string:
       'Peel off leading AND/OR
       If Mid(StWhere$, 2, 2) = "OR" Then
     StWhere$ = Mid(StWhere$, 5, Len(StWhere$) - 5)
       Else
     stTmp$ = stGetToken(StWhere$, " ")
       End If
       If StWhere$ <> "" Then
     StWhere$ = " Where " + StWhere$
     Else
     StWhere$ = " Where " + cCriteria
       End If
     End If
     ' get rid of brackets
     ' check for more brackets until nomore
     Do
     ns = InStr(1, StWhere$, "'[")
     If ns <> 0 Then
     nsflds = Mid(StWhere$, 1, ns)
     nv$ = Mid$(StWhere$, ns + 2, Len(StWhere$))
     nsflds = nsflds + nv$
     ns = InStr(1, nsflds, "]'")
     nv$ = Mid$(nsflds, ns + 1, Len(nsflds))
     nv$ = Mid(nsflds, 1, ns - 1) + nv$
     StWhere$ = nv$
     End If
     Loop Until ns = 0
     'check for join condition
     If joins <> "" Then
     StWhere$ = "," + joins + " " + StWhere$
     End If
     'check

     'check for order by field
     If cOrderByField <> "(none)" Then
    '  check for dbo. in field
    If UCase(Left(cOrderByField, 4)) = "DBO." Then
        nsflds = Mid(cOrderByField, 5, Len(cOrderByField))
        ns = InStr(1, nsflds, ".")
        nsflds = "[" + Mid(nsflds, ns + 1, Len(nsflds)) + "]"
        nv$ = Mid(cOrderByField, 5, ns) + nsflds
        StWhere$ = StWhere$ + " Order By " + nv$
    Else
        ns = InStr(1, cOrderByField, ".")
        nsflds = "[" + Mid(cOrderByField, ns + 1, Len(cOrderByField)) + "]"
        nv$ = Left(cOrderByField, ns) + nsflds
        StWhere$ = StWhere$ + " Order By " + nv$
    End If
     End If
     'get show field names and strip out sql servers dbo. field preface
     For I% = 0 To cColOrder.ListCount - 1
       If UCase(Left(cColOrder.List(I%), 4)) = "DBO." Then
             nsflds = Mid(cColOrder.List(I%), 5, Len(cColOrder.List(I%)))
             ns = InStr(1, nsflds, ".")
             nsflds = Mid(nsflds, ns + 1, Len(nsflds))
             nsflds = "[" + nsflds + "]"
             nsflds = Left(Mid(cColOrder.List(I%), 5, Len(cColOrder.List(I%))), ns) + nsflds
             fs = fs + nsflds + ","
        Else

             ns = InStr(1, cColOrder.List(I%), ".")
             nsflds = Mid(cColOrder.List(I%), ns + 1, Len(cColOrder.List(I%)))
             ntflds = Left(cColOrder.List(I%), ns - 1)
             nt = InStr(1, ntflds, " ")
             If nt > 0 Then
            ntflds = "[" + ntflds + "]"
            nsflds = ntflds + "." + "[" + nsflds + "]"
             Else
             nsflds = "[" + nsflds + "]"
             nsflds = Left(cColOrder.List(I%), ns) + nsflds
             End If

             fs = fs + nsflds + ","
       End If
       Next
     If fs = "" Then
       For I% = 0 To cTableList.ListCount - 1
    If cTableList.Selected(I%) Then
        If UCase(Left(cTableList.Selected(I%), 4)) = ".DBO" Then
        fs = fs + Mid(cTableList.Selected(I%), 5, Len(cTableList.Selected(I%)))
         Else
        fs = fs + cTableList.List(I%) + ".*,"
        End If
     End If
       Next
       If fs = "" Then
     fs = "*"
       Else
     fs = Mid(fs, 1, Len(fs) - 1)     'take off the last ","
       End If
     Else
       fs = Mid(fs, 1, Len(fs) - 1)
     End If
     'get table names
     For I% = 0 To cTableList.ListCount - 1
       If cTableList.Selected(I%) Then
        If UCase(Left(cTableList.List(I%), 4)) = "DBO." Then
        ts = ts + Mid(cTableList.List(I%), 5, Len(cTableList.List(I%))) + ","
         Else
        ts = ts + cTableList.List(I%) + ","
        End If
       End If
     Next
     ts = Mid(ts, 1, Len(ts) - 1)
     nt = InStr(1, ts, " ")
     If nt > 0 Then
     ts = "[" + ts + "]"
     End If
     gstDynaString = "Select " + fs + " From " + ts + StWhere$
     gfFROMSQL = False ' not a SQL statement
If Option1(0) = False Then
     Dim dsform1 As New fDynaset
     dsform1.Show
       Else
     Dim dsform2 As New fGridFrm
     dsform2.Show
       End If
     GoTo OKEnd
OKErr:
  If Err = 364 Then Resume OKEnd   'catch unloaded form
  ShowError
  Resume OKEnd
OKEnd:
  MsgBar "", False
End Sub
Sub RunSaveQryButton_Click ()
fStoreQry.Show 1
If gstDynaString <> "" Then
cCriteria.Text = gstDynaString
MsgBar "Stored Query is Loaded", False
Me.Tag = gstDynaString
gStoredFlag = True
End If
End Sub
Function stGetToken (stLn$, stDelim$) As String
    On Error GoTo GetTokenError
    iOpenQuote% = InStr(1, stLn$, """")
    iDelim% = InStr(1, stLn$, stDelim$)
    iBracket% = InStr(1, stLn$, "[")
    If (iOpenQuote% > 0) And (iOpenQuote% < iDelim%) Then
     iCloseQuote% = InStr(iOpenQuote% + 1, stLn$, """")
     iDelim% = InStr(iCloseQuote% + 1, stLn$, stDelim$)
    End If
    If (iDelim% <> 0) And (iDelim% < iBracket%) Then
     stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1, iDelim% - 1)))
     stLn$ = Mid$(stLn$, iDelim% + 1)
    Else
     stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1)))
     stLn$ = ""
    End If
    If (Len(stToken$) > 0) Then
     If (Mid$(stToken$, 1, 1) = """") Then
          stToken$ = Mid$(stToken$, 2)
     End If
     If (Mid$(stToken$, Len(stToken$), 1) = """") Then
          stToken$ = Mid$(stToken$, 1, Len(stToken$) - 1)
     End If
    End If
    stGetToken = stToken$
GetTokenExit:
    Exit Function
GetTokenError:
    Resume GetTokenExit
End Function
'function to split the table and the field from a tbl.fld pair
Function stSTF (tf As String, part As Integer) As String
  If part = 0 Then
    stSTF = Mid(tf, 1, InStr(1, tf, ".") - 1)
  Else
    stSTF = Mid(tf, InStr(1, tf, ".") + 1, Len(tf))
  End If
End Function