Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "Query Builder"
'ResMe Converted To A Property: Const BUTTON1 = "&And into Criteria"
'ResMe Converted To A Property: Const BUTTON2 = "&Or into Criteria"
'ResMe Converted To A Property: Const BUTTON3 = "List &Possible Values"
Const BUTTON4 = "Set Table &Joins"
'ResMe Converted To A Property: Const BUTTON5 = "&Run"
'ResMe Converted To A Property: Const BUTTON6 = "&Show"
'ResMe Converted To A Property: Const BUTTON7 = "Cop&y"
'ResMe Converted To A Property: Const BUTTON8 = "Sa&ve"
'ResMe Converted To A Property: Const BUTTON9 = "C&lear"
'ResMe Converted To A Property: Const BUTTON10 = "&Close"
'ResMe Converted To A Property: Const Label1 = "Field Name:"
'ResMe Converted To A Property: Const Label2 = "Operator:"
'ResMe Converted To A Property: Const LABEL3 = "Value:"
'ResMe Converted To A Property: Const LABEL4 = "Tables:"
'ResMe Converted To A Property: Const LABEL5 = "Fields to Show:"
'ResMe Converted To A Property: Const LABEL6 = "Group By:"
'ResMe Converted To A Property: Const LABEL7 = "Order By:"
'ResMe Converted To A Property: Const LABEL8 = "Top N Value:"
'ResMe Converted To A Property: Const LABEL9 = "Criteria:"
'ResMe Converted To A Property: Const CHECK1 = "Top Percent"
'ResMe Converted To A Property: Const MSG1 = "Updating Form Fields"
'ResMe Converted To A Property: Const MSG2 = "(none)"
'ResMe Converted To A Property: Const MSG3 = "You Must Have at Least 2 Tables Selected!"
'ResMe Converted To A Property: Const MSG4 = "Choose Joins"
'ResMe Converted To A Property: Const MSG5 = "No Query Entered!"
'ResMe Converted To A Property: Const MSG6 = "Building Query"
'ResMe Converted To A Property: Const MSG7 = "Running Query"
'ResMe Converted To A Property: Const MSG8 = "Enter QueryDef Name:"
'>>>>>>>>>>>>>>>>>>>>>>>>


Dim mbShowSQL As Integer
Dim mbCopySQL As Integer
Dim mbSaveSQL As Integer

Private Sub cmdAnd_Click()
  Dim nFldType As Integer
  Dim sFieldName As String
  Dim sTableName As String

  If Len(cboField.Text) = 0 Then Exit Sub

  sTableName = stSTF((cboField), 0)
  sFieldName = stSTF((cboField), 1)
  nFldType = gdbCurrentDB.TableDefs(StripBrackets(sTableName)).Fields(StripBrackets(sFieldName)).Type
  
  If Len(txtCriteria.Text) > 0 Then
    txtCriteria.Text = txtCriteria.Text & vbCrLf & "And "
  End If
  If nFldType = dbText Or nFldType = dbMemo Or nFldType = dbDate Then
    txtCriteria.Text = txtCriteria.Text & cboField.Text & " " & cboOperator.Text & " '" & cboValue.Text & "'"
  Else
    txtCriteria.Text = txtCriteria.Text & cboField.Text & " " & cboOperator.Text & " " & cboValue.Text
  End If
  cboField.SetFocus
End Sub

Private Sub cboField_Click()
  cboValue.Clear
End Sub

Private Sub cmdClear_Click()
  On Error Resume Next
  Dim i As Integer
  
  For i = 0 To lstTables.ListCount - 1
    lstTables.Selected(i) = False
  Next
  txtCriteria.Text = vbNullString
  txtTopNValue.Text = vbNullString
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdCopySQL_Click()
  mbCopySQL = True
  Call cmdRunQuery_Click
  mbCopySQL = False
End Sub

Private Sub cmdSaveQDF_Click()
  mbSaveSQL = True
  Call cmdRunQuery_Click
  mbSaveSQL = False
End Sub

Private Sub lstTables_Click()
  On Error GoTo LTErr

  Dim i As Integer, ii As Integer
  Dim tdf As TableDef
  Dim qdf As QueryDef
  Dim sTmp As String
  Dim fld As Field

  MsgBar MSG1, True
  cboField.Clear
  lstShowFields.Clear
  cboGroupByField.Clear
  cboOrderByField.Clear
  cboValue.Clear

  cboGroupByField.AddItem MSG2
  cboOrderByField.AddItem MSG2

  For ii = 0 To lstTables.ListCount - 1
    If lstTables.Selected(ii) Then
      If lstTables.ItemData(ii) = 0 Then
        'must be a table
        Set tdf = gdbCurrentDB.TableDefs(lstTables.List(ii))
        For Each fld In tdf.Fields
          sTmp = AddBrackets((lstTables.List(ii))) & "." & AddBrackets((fld.Name))
          cboField.AddItem sTmp
          lstShowFields.AddItem sTmp
          cboGroupByField.AddItem sTmp
          cboOrderByField.AddItem sTmp
        Next
      Else
        'must be a querydef
        Set qdf = gdbCurrentDB.QueryDefs(lstTables.List(ii))
        For Each fld In qdf.Fields
          sTmp = AddBrackets((lstTables.List(ii))) & "." & AddBrackets((fld.Name))
          cboField.AddItem sTmp
          lstShowFields.AddItem sTmp
          cboGroupByField.AddItem sTmp
          cboOrderByField.AddItem sTmp
        Next
      End If
    End If
  Next
  If Len(cboField.List(0)) > 0 Then
    cboField.ListIndex = 0
    cboGroupByField.ListIndex = 0
    cboOrderByField.ListIndex = 0
  End If
  MsgBar vbNullString, False
  Exit Sub
  
LTErr:
  ShowError
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016115
  End If
End Sub

Private Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmQuery_Auto_Init
  On Local Error GoTo FLErr

  Dim rec As Recordset
  Dim i As Integer

  Me.Caption = FORMCAPTION
  cmdAnd.Caption = BUTTON1
  cmdOr.Caption = BUTTON2
  cmdGetValues.Caption = BUTTON3
  cmdJoin.Caption = BUTTON4
  cmdRunQuery.Caption = BUTTON5
  cmdShowSQL.Caption = BUTTON6
  cmdCopySQL.Caption = BUTTON7
  cmdSaveQDF.Caption = BUTTON8
  cmdClear.Caption = BUTTON9
  cmdClose.Caption = BUTTON10
  lblLabels(0).Caption = Label1
  lblLabels(1).Caption = Label2
  lblLabels(2).Caption = LABEL3
  lblLabels(3).Caption = LABEL4
  lblLabels(4).Caption = LABEL5
  lblLabels(5).Caption = LABEL6
  lblLabels(6).Caption = LABEL7
  lblLabels(7).Caption = LABEL8
  lblLabels(8).Caption = LABEL9
  chkTopPercent.Caption = CHECK1
  
  'Clear listbox
  txtCriteria.Text = vbNullString

  cboOperator.AddItem "="
  cboOperator.AddItem "<>"
  cboOperator.AddItem ">"
  cboOperator.AddItem ">="
  cboOperator.AddItem "<"
  cboOperator.AddItem "<="
  cboOperator.AddItem "Like"
  cboOperator.ListIndex = 0

  'fill the table list
  GetTableList lstTables, False, False, True
  lstTables.ListIndex = 0

  cboValue.Text = vbNullString

  Height = 5520
  Width = 7224
  Left = (frmMDI.Width - Width) / 2
  Top = 0
  Exit Sub

FLErr:
  ShowError
End Sub

Private Sub Form_Resize()
  On Error Resume Next

  If WindowState <> 1 Then
    Me.Height = 5430
    Me.Width = 7575
  End If
End Sub

Private Sub cmdGetValues_Click()
  On Error GoTo GVErr

  Dim rec As Recordset

  MsgBar "Getting Possible Values", True
  Screen.MousePointer = vbHourglass
  Set rec = gdbCurrentDB.OpenRecordset("select Distinct " & StripOwner(cboField) & " from " & stSTF((cboField), 0))
  Do While rec.EOF = False
    If Len(Trim(rec(0))) > 0 Then
      cboValue.AddItem rec(0).Value
    End If
    rec.MoveNext
  Loop
  rec.Close
  cboValue.Text = cboValue.List(0)
  cboValue.SetFocus

  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Exit Sub

GVErr:
  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  cboValue.Text = vbNullString
  Exit Sub

End Sub

Private Sub cmdJoin_Click()
  Dim i As Integer
  Dim c As Integer

  For i = 0 To lstTables.ListCount - 1
    If lstTables.Selected(i) Then
      c = c + 1
    End If
  Next
  If c < 2 Then
    Beep
    MsgBox MSG3, 48
  Else
    MsgBar MSG4, False
    frmJoin.Show vbModal
    MsgBar vbNullString, False
  End If
End Sub

Private Sub cmdOr_Click()
  Dim nType As Integer
  Dim sFieldName As String
  Dim sTableName As String

  If Len(cboField.Text) = 0 Then Exit Sub

  sTableName = stSTF((cboField), 0)
  sFieldName = stSTF((cboField), 1)
  nType = gdbCurrentDB.TableDefs(StripBrackets(sTableName)).Fields(StripBrackets(sFieldName)).Type

  If Len(txtCriteria.Text) > 0 Then
    txtCriteria.Text = txtCriteria.Text & vbCrLf & " Or "
  End If
  If nType = dbText Or nType = dbMemo Or nType = dbDate Then
    txtCriteria.Text = txtCriteria.Text & cboField.Text & " " & cboOperator.Text & " '" & cboValue.Text & "'"
  Else
    txtCriteria.Text = txtCriteria.Text & cboField.Text & " " & cboOperator.Text & " " & cboValue.Text
  End If
  cboField.SetFocus

End Sub

Private Sub cmdRunQuery_Click()

  On Error GoTo OKErr

  Dim rsTmp As Recordset
  Dim frmTmp As Form
  Dim fs As String
  Dim ts As String
  Dim i As Integer
  Dim sWhere As String
  Dim sWhere2 As String
  Dim sNewWhere As String
  Dim sTmp As String
  Dim bMatchParen As Integer
  Dim sQueryName As String
  Dim qdfTmp As QueryDef
  Dim sSQLString As String

  If lstShowFields.ListCount = 0 Then
    MsgBox MSG5, vbExclamation
    Exit Sub
  End If

  MsgBar MSG6, True
  If Len(txtCriteria.Text) > 0 Then
    sWhere = "AND " & LTrim(txtCriteria.Text)
    'strip vbcrlfs
    For i = 1 To Len(sWhere)
      If Mid(sWhere, i, 1) = Chr(13) Then
        sTmp = sTmp & " "
      ElseIf Mid(sWhere, i, 1) = Chr(10) Then
        'do nothing
      Else
        sTmp = sTmp + Mid(sWhere, i, 1)
      End If
    Next
    sWhere = sTmp

    sWhere = RTrim(sWhere)

    'Add parens to sWhere
     sWhere2 = sWhere
     Do
       sTmp = stGetToken(sWhere2, " ")
       sTmp = sTmp & " "
        If bMatchParen = False And UCase(sTmp) = "AND " Then
         sNewWhere = sNewWhere + sTmp & "("
         bMatchParen = True
       ElseIf bMatchParen And UCase(sTmp) = "AND " Then
         sNewWhere = sNewWhere & ") " & sTmp & "("
         'bMatchParen = False
       Else
         If UCase(sTmp) = "OR" Or UCase(sTmp) = "IN " Or UCase(sTmp) = "LIKE" Then
           sNewWhere = sNewWhere & " " & sTmp
         Else
           sNewWhere = sNewWhere + sTmp
         End If
       End If

     Loop Until sWhere2 = vbNullString
     sWhere = sNewWhere & ")"

    'Build DynaSet string:
    'Peel off leading AND/OR
    If Mid(sWhere, 2, 2) = "OR" Then
      sWhere = Mid(sWhere, 5, Len(sWhere) - 5)
    Else
      sTmp = stGetToken(sWhere, " ")
    End If

    If Len(sWhere) > 0 Then
      sWhere = " Where " & sWhere
    End If

  End If

  'check for join condition
  If lstJoinFields.ListCount > 0 Then
    If Len(sWhere) = 0 Then
      sWhere = sWhere & " Where "
    Else
      sWhere = sWhere & " And "
    End If
    For i = 0 To lstJoinFields.ListCount - 1
      sWhere = sWhere + lstJoinFields.List(i) & " And "
    Next
    sWhere = Mid(sWhere, 1, Len(sWhere) - 5)
  End If

  'check for group by field
  If cboGroupByField <> MSG2 Then
    sWhere = sWhere & " Group By " & cboGroupByField
  End If

  'check for order by field
  If cboOrderByField <> MSG2 Then
    sWhere = sWhere & " Order By " & cboOrderByField
    If optOrder(1).Value Then
      sWhere = sWhere & " Desc "
    End If
  End If

  'get show field names
  For i% = 0 To lstShowFields.ListCount - 1
    If lstShowFields.Selected(i%) Then
      fs = fs + lstShowFields.List(i%) & ","
    End If
  Next
  If Len(fs) = 0 Then
    For i% = 0 To lstTables.ListCount - 1
      If lstTables.Selected(i%) Then
        fs = fs + AddBrackets((lstTables.List(i%))) & ".*,"
      End If
    Next
    If Len(fs) = 0 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 lstTables.ListCount - 1
    If lstTables.Selected(i%) Then
      ts = ts + AddBrackets((lstTables.List(i%))) & ","
    End If
  Next
  ts = Mid(ts, 1, Len(ts) - 1)

  sSQLString = "Select "
  
  'set Top N Value if present
  If Len(txtTopNValue.Text) > 0 Then
    sSQLString = sSQLString & " TOP " & txtTopNValue.Text & " "
    If chkTopPercent.Value = vbChecked Then
      sSQLString = sSQLString & " PERCENT "
    End If
  End If
  
  sSQLString = sSQLString & fs & " From " & ts + sWhere
  
  If mbShowSQL = False And mbCopySQL = False And mbSaveSQL = False Then
    MsgBar MSG7, True
    OpenQuery sSQLString, True
    
  ElseIf mbShowSQL Then
    MsgBar vbNullString, False
    MsgBox sSQLString, 0, "SQL Query"
  
  ElseIf mbCopySQL Then
    frmSQL.txtSQLStatement.Text = sSQLString
  
  ElseIf mbSaveSQL Then
    MsgBar vbNullString, False
    sQueryName = InputBox(MSG8)
    If Len(sQueryName) = 0 Then Exit Sub
  
    'check for a dupe and exit if the user won't overwrite it
    If DupeTableName(sQueryName) Then
      Exit Sub
    End If
    'add the new querydef
    Set qdfTmp = gdbCurrentDB.CreateQueryDef(sQueryName, sSQLString)
    RefreshTables Nothing
  End If

  MsgBar vbNullString, False
  Exit Sub

OKErr:
  If Err = 364 Then Exit Sub   'catch unloaded form
  ShowError
End Sub

Private Sub cmdShowSQL_Click()
  mbShowSQL = True
  Call cmdRunQuery_Click
  mbShowSQL = False
End Sub

Private Function stGetToken(rsLine As String, rsDelim As String) As String
  On Error GoTo GetTokenError
  
  Dim iOpenQuote As Integer
  Dim iCloseQuote As Integer
  Dim iDelim As Integer
  Dim stToken As String

  iOpenQuote = InStr(1, rsLine, """")
  iDelim = InStr(1, rsLine, rsDelim)

  If (iOpenQuote > 0) And (iOpenQuote < iDelim) Then
    iCloseQuote = InStr(iOpenQuote + 1, rsLine, """")
    iDelim = InStr(iCloseQuote + 1, rsLine, rsDelim)
  End If

  If (iDelim% <> 0) Then
    stToken = LTrim(RTrim(Mid(rsLine, 1, iDelim - 1)))
    rsLine = Mid(rsLine, iDelim + 1)
  Else
    stToken = LTrim(RTrim(Mid(rsLine, 1)))
    rsLine = vbNullString
  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
  Exit Function

GetTokenError:
  Exit Function

End Function

'function to split the table and the field from a tbl.fld pair
Private Function stSTF(rsName As String, rnPart As Integer) As String
  If InStr(InStr(1, rsName, ".") + 1, rsName, ".") > 1 Then
    rsName = StripOwner(rsName)
  End If
  If rnPart = 0 Then
    stSTF = Mid(rsName, 1, InStr(1, rsName, ".") - 1)
  Else
    stSTF = Mid(rsName, InStr(1, rsName, ".") + 1, Len(rsName))
  End If
End Function


'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const FORMCAPTION = "Query Builder"
Property Get FORMCAPTION As String
    FORMCAPTION = "Query Builder"
End Property

'This was: Const BUTTON1 = "&And into Criteria"
Property Get BUTTON1 As String
    BUTTON1 = "&And into Criteria"
End Property

'This was: Const BUTTON2 = "&Or into Criteria"
Property Get BUTTON2 As String
    BUTTON2 = "&Or into Criteria"
End Property

'This was: Const BUTTON3 = "List &Possible Values"
Property Get BUTTON3 As String
    BUTTON3 = "List &Possible Values"
End Property

'This was: Const BUTTON5 = "&Run"
Property Get BUTTON5 As String
    BUTTON5 = "&Run"
End Property

'This was: Const BUTTON6 = "&Show"
Property Get BUTTON6 As String
    BUTTON6 = "&Show"
End Property

'This was: Const BUTTON7 = "Cop&y"
Property Get BUTTON7 As String
    BUTTON7 = "Cop&y"
End Property

'This was: Const BUTTON8 = "Sa&ve"
Property Get BUTTON8 As String
    BUTTON8 = "Sa&ve"
End Property

'This was: Const BUTTON9 = "C&lear"
Property Get BUTTON9 As String
    BUTTON9 = "C&lear"
End Property

'This was: Const BUTTON10 = "&Close"
Property Get BUTTON10 As String
    BUTTON10 = "&Close"
End Property

'This was: Const Label1 = "Field Name:"
Property Get Label1 As String
    Label1 = "Field Name:"
End Property

'This was: Const Label2 = "Operator:"
Property Get Label2 As String
    Label2 = "Operator:"
End Property

'This was: Const LABEL3 = "Value:"
Property Get LABEL3 As String
    LABEL3 = "Value:"
End Property

'This was: Const LABEL4 = "Tables:"
Property Get LABEL4 As String
    LABEL4 = "Tables:"
End Property

'This was: Const LABEL5 = "Fields to Show:"
Property Get LABEL5 As String
    LABEL5 = "Fields to Show:"
End Property

'This was: Const LABEL6 = "Group By:"
Property Get LABEL6 As String
    LABEL6 = "Group By:"
End Property

'This was: Const LABEL7 = "Order By:"
Property Get LABEL7 As String
    LABEL7 = "Order By:"
End Property

'This was: Const LABEL8 = "Top N Value:"
Property Get LABEL8 As String
    LABEL8 = "Top N Value:"
End Property

'This was: Const LABEL9 = "Criteria:"
Property Get LABEL9 As String
    LABEL9 = "Criteria:"
End Property

'This was: Const CHECK1 = "Top Percent"
Property Get CHECK1 As String
    CHECK1 = "Top Percent"
End Property

'This was: Const MSG1 = "Updating Form Fields"
Property Get MSG1 As String
    MSG1 = "Updating Form Fields"
End Property

'This was: Const MSG2 = "(none)"
Property Get MSG2 As String
    MSG2 = "(none)"
End Property

'This was: Const MSG3 = "You Must Have at Least 2 Tables Selected!"
Property Get MSG3 As String
    MSG3 = "You Must Have at Least 2 Tables Selected!"
End Property

'This was: Const MSG4 = "Choose Joins"
Property Get MSG4 As String
    MSG4 = "Choose Joins"
End Property

'This was: Const MSG5 = "No Query Entered!"
Property Get MSG5 As String
    MSG5 = "No Query Entered!"
End Property

'This was: Const MSG6 = "Building Query"
Property Get MSG6 As String
    MSG6 = "Building Query"
End Property

'This was: Const MSG7 = "Running Query"
Property Get MSG7 As String
    MSG7 = "Running Query"
End Property

'This was: Const MSG8 = "Enter QueryDef Name:"
Property Get MSG8 As String
    MSG8 = "Enter QueryDef Name:"
End Property


Private Sub frmQuery_Auto_Init()
'This routine initializes all User Interface control properties on frmQuery.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    Me.Caption = "Query"
    optOrder(1).Caption = "Desc"
    optOrder(0).Caption = "Asc"
    chkTopPercent.Caption = "Top Percent"
    cmdGetValues.Caption = "List &Possible Values"
    cmdOr.Caption = "&Or into Criteria"
    cmdAnd.Caption = "&And into Criteria"
    cboValue.Text = "cValue"
    cmdSaveQDF.Caption = "Sa&ve"
    cmdJoin.Caption = "Set Table &Joins"
    cmdCopySQL.Caption = "Cop&y"
    cmdShowSQL.Caption = "&Show"
    cmdClose.Caption = "&Close"
    cmdRunQuery.Caption = "&Run"
    cmdClear.Caption = "C&lear"
    lblLabels(7).Caption = "Top N Value:"
    lblLabels(1).Caption = "Operator:"
    lblLabels(2).Caption = "Value:"
    lblLabels(0).Caption = "Field Name:"
    lblLabels(6).Caption = "Order By: "
    lblLabels(5).Caption = "Group By: "
    lblLabels(3).Caption = "Tables: "
    lblLabels(4).Caption = "Fields to Show: "
    lblLabels(8).Caption = "Criteria: "
End Sub