home *** CD-ROM | disk | FTP | other *** search
- 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 = 6195
- Icon = MQUERY.FRX:0000
- KeyPreview = -1 'True
- Left = 1335
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 5709.895
- ScaleMode = 0 'User
- ScaleWidth = 9625.69
- Top = 1770
- Width = 9375
- Begin SSPanel PnlHelp
- Alignment = 1 'Left Justify - MIDDLE
- AutoSize = 1 'AutoSize Panel Width To Caption
- BackColor = &H0000FFFF&
- BevelOuter = 0 'None
- BorderWidth = 1
- 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
- BevelInner = 1 'Inset
- FontBold = -1 'True
- FontItalic = 0 'False
- FontName = "Arial"
- FontSize = 9.75
- FontStrikethru = 0 'False
- FontUnderline = 0 'False
- 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
-