home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
m_query
/
mquery.frm
< prev
next >
Wrap
Text File
|
1994-05-24
|
27KB
|
994 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 = 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
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
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
Next
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$
Do
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