Attribute VB_Name = "modSQLinterface"
Option Explicit

'Create a part of an SQL WHERE clause based on the value in a TextBox
'txt       - TextBox containing value to match
'fieldName - SQL name of field in database
'ignore    - string to ignore and treat as a blank if it appears in the grid
Public Function TextBoxToSQL(txt As TextBox, fieldName$, Optional ignore$ = "") As String
  Dim str$
  str = Trim(txt.text)
  If str = "" Or LCase(str) = LCase(ignore) Then
    TextBoxToSQL = ""
  Else
    TextBoxToSQL = fieldName & " = " & str
  End If
End Function

'Populates a column of an ATCoGrid from an SQL WHERE clause
'sql       - SQL WHERE clause
'txt       - TextBox to populate
'col       - column of grid to populate (0..agd.cols - 1)
'fieldName - SQL name of field in database (e.g. Site.CountyCd)
'fieldName should have only one possible value in SQL (field = value) rather than field in (v1, v2)
Public Sub TextBoxFromSQL(sql As String, txt As TextBox, fieldName$)
  Dim UcaseSQL$, searchFor$
  Dim startSearch&, endSearch&
  Dim openParen&, closeParen&, equalPos&
  Dim curpos&, nextOr&
  
  txt.text = ""
  
  endSearch = 0
  UcaseSQL = UCase(sql)
  searchFor = UCase(fieldName)
  startSearch = InStr(UcaseSQL, searchFor)
  If startSearch > 0 Then
    startSearch = startSearch + Len(searchFor)
    openParen = InStr(startSearch, UcaseSQL, "(")
    equalPos = InStr(startSearch, UcaseSQL, "=")
    
    'If this looks like fieldname = 'Kansas' rather than fieldname LIKE/IN ('KS', 'VA')
    If equalPos > 0 And (equalPos < openParen Or openParen = 0) Then
      startSearch = InStr(equalPos, UcaseSQL, "'")
      If startSearch > 0 Then
        endSearch = InStr(startSearch + 1, UcaseSQL, "'")
      Else
        startSearch = equalPos + 1
      End If
    ElseIf openParen > 0 Then 'This should not happen, but if it does we will put all values in the text box
      startSearch = openParen + 1
      endSearch = InStr(openParen, UcaseSQL, ")")
    End If
    If endSearch = 0 Then endSearch = Len(UcaseSQL)
    UcaseSQL = Mid(UcaseSQL, startSearch, endSearch - startSearch + 1)
    curpos = InStr(UcaseSQL, "'")
    While curpos > 0 And curpos < Len(UcaseSQL)
      nextOr = InStr(curpos + 1, UcaseSQL, "'")
      If nextOr < 1 Then nextOr = Len(UcaseSQL)
      If txt.text = "" Then
        txt.text = Mid(sql, startSearch + curpos, nextOr - curpos - 1)
      Else
        txt.text = txt.text & " " & Mid(sql, startSearch + curpos, nextOr - curpos - 1)
      End If
      curpos = InStr(nextOr + 1, UcaseSQL, "'")
    Wend
  End If
End Sub
'Create a part of an SQL WHERE clause based on values in a column of an ATCoGrid
'agd       - grid to scan
'col       - column of grid to scan (0..agd.cols - 1)
'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)
'firstWord - true if values in the column should be truncated at the first space
'ignore    - string to ignore and treat as a blank if it appears in the grid
'
' Public Function GridColumnToSQL(agd As ATCoGrid, col&, fieldName$, inLike$, _
'                               Optional firstWord As Boolean = False, _
'                               Optional ignore$ = "") As String
'
'Public Function GridColumnToSQL(agd As ATCoGrid, _
'                                ByVal col&, _
'                                fieldName$, _
'                                inLike$, _
'                                Optional firstWord As Boolean = False, _
'                                Optional ignore$ = "") As String
''  Dim sql$, totalIn&, totalLike&, row&, str$, spcPos&, total&
''  Dim equals As Boolean
''  equals = False
''
''  'First we count values
''  totalIn = 0
''  totalLike = 0
''  For row = 1 To agd.Rows
''    str = Trim(agd.TextMatrix(row, col))
''    If Len(str) > 0 And str <> ignore Then
''      If InStr(str, "?") > 0 Then
''        GoSub AddLike
''      ElseIf InStr(str, "*") > 0 Then
''        GoSub AddLike
''      Else
''        totalIn = totalIn + 1
''      End If
''    End If
''  Next row
''  If totalIn + totalLike = 0 Then Exit Function 'might as well quit now, return value is ""
''  If totalIn = 1 Then equals = True
''
''  'Replace ? and * with SQL equivalents
''  If totalLike > 0 Then
''    If totalLike = 1 Then sql = Mid(sql, 2, Len(sql) - 2) 'remove parens
''    sql = ReplaceString(sql, "?", "_")
''    sql = ReplaceString(sql, "*", "%")
''  End If
''
''  If totalIn > 0 Then
''    totalIn = 0
''    For row = 1 To agd.Rows
''      str = Trim(agd.TextMatrix(row, col))
''      If Len(str) > 0 And str <> ignore Then
''        totalIn = totalIn + 1
''        If firstWord Then
''          spcPos = InStr(str, " ")
''          If spcPos > 0 Then str = Left(str, spcPos - 1)
''        End If
''        If total = 1 Then       'first usable value in column, add preamble
''          sql = sql & fieldName
''          If equals Then sql = sql & " = " Else sql = sql & SQL_IN & "("
''        Else                    'additional usable value in column, continue with comma
''          sql = sql & ", "
''        End If
''        sql = sql & "'" & str & "'"
''      End If
''    Next row
''    If total > 0 And Not equals Then sql = sql & ")"
''  End If
''
''  GridColumnToSQL = sql
''  Exit Function
''AddLike:
''  totalLike = totalLike + 1
''  If totalLike > 1 Then sql = sql & SQL_OR
''  If firstWord Then
''    spcPos = InStr(str, " ")
''    If spcPos > 0 Then str = Left(str, spcPos - 1)
''  End If
''  sql = sql & "(" & fieldName & SQL_LIKE & str & ")"
''  Return
''End Function
''
''
''
''Create a part of an SQL WHERE clause based on values in a column of an ATCoGrid
''agd       - grid to scan
''col       - column of grid to scan (0..agd.cols - 1)
''fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)
''inLike    - a string - probably SQL_IN or SQL_LIKE - to be used in constructing the SQL
''firstWord - true if values in the column should be truncated at the first space
''ignore    - string to ignore and treat as a blank if it appears in the grid
'Public Function GridColumnToSQL(agd As ATCoGrid, col&, fieldName$, inLike$, _
'                               Optional firstWord As Boolean = False, _
'                               Optional ignore$ = "") As String
'  Dim sql$, total&, row&, str$, spcPos&
'  Dim equals As Boolean
'  equals = False
'
'  If inLike = SQL_IN Then
'    total = 0
'    For row = 1 To agd.Rows
'      str = Trim(agd.TextMatrix(row, col))
'      If Len(str) > 0 And str <> ignore Then
'        total = total + 1
'      End If
'    Next row
'    If total = 0 Then Exit Function 'might as well quit now, return value is ""
'    If total = 1 Then equals = True
'  End If
'
'  total = 0
'  For row = 1 To agd.Rows
'    str = Trim(agd.TextMatrix(row, col))
'    If Len(str) > 0 And str <> ignore Then
'      total = total + 1
'      If firstWord Then
'        spcPos = InStr(str, " ")
'        If spcPos > 0 Then str = Left(str, spcPos - 1)
'      End If
'      If total = 1 Then       'first usable value in column, add preamble
'        sql = sql & fieldName
'        If equals Then sql = sql & " = " Else sql = sql & inLike & "("
'      Else                    'additional usable value in column, continue with comma
'        sql = sql & ", "
'      End If
'      sql = sql & "'" & str & "'"
'    End If
'  Next row
'  If total > 0 And Not equals Then sql = sql & ")"
'
'  'Replace ? and * with SQL equivalents
'  If InStr(inLike, SQL_LIKE) > 0 Then
'
'  End If
'
'  GridColumnToSQL = sql
'End Function

'Create a part of an SQL WHERE clause based on values in a column of an ATCoGrid
'agd       - grid to scan
'col       - column of grid to scan (0..agd.cols - 1)
'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)
'firstWord - true if values in the column should be truncated at the first space
'ignore    - string to ignore and treat as a blank if it appears in the grid


'Create a part of an SQL WHERE clause based on values in a column of an ATCoGrid

'agd       - grid to scan

'col       - column of grid to scan (0..agd.cols - 1)

'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)

'firstWord - true if values in the column should be truncated at the first space

'ignore    - string to ignore and treat as a blank if it appears in the grid

Public Function GridColumnToSQL(agd As ATCoGrid, _
                                ByVal col As Integer, _
                                fieldName As String, _
                                Optional dummy$, _
                                Optional firstWord As Boolean = False, _
                                Optional ignore$ = "") As String

  Dim strIN$, totalIn&, totalLike&, Row&, str$, strLike$, spcPos&, lastStrIN As String

  

  For Row = 1 To agd.rows

    str = UCase(Trim(agd.TextMatrix(Row, col)))

'    str = ReplaceString(str, "?", "_")

'    str = ReplaceString(str, "*", "%")

    If Len(str) > 0 And str <> UCase(ignore) Then

      str = "'" & str & "'"

      If InStr(str, "?") > 0 Then

        GoSub AddLike

      ElseIf InStr(str, "*") > 0 Then

        GoSub AddLike

      Else

        totalIn = totalIn + 1

        If firstWord Then

          spcPos = InStr(str, " ")

          If spcPos > 0 Then str = Left(str, spcPos - 1) & "'"

        End If

        lastStrIN = str

        If totalIn = 1 Then      'first IN value in column, add preamble

          strIN = strIN & fieldName & SQL_IN & "("

        Else                    'additional usable value in column, continue with comma

          strIN = strIN & ", "

        End If

        strIN = strIN & str

      End If

    End If

  Next Row



  If totalIn + totalLike = 0 Then Exit Function 'might as well quit now, return value is ""

  If totalLike = 1 Then strLike = Mid(strLike, 2, Len(strLike) - 2) 'remove parens

  If totalIn = 1 Then 'If only one IN value, simplify field IN ('value') to field = 'value'

    strIN = fieldName & " = " & lastStrIN

  ElseIf totalIn > 1 Then 'Close paren of IN

    strIN = strIN & ")"

  End If



  If totalIn > 0 And totalLike > 0 Then 'Both IN and LIKE are used, OR them together

    GridColumnToSQL = strIN & SQL_OR & strLike

  Else 'One is empty, so simply concatenating them will give the one that exists

    GridColumnToSQL = strIN & strLike

  End If



  Exit Function



AddLike:



  totalLike = totalLike + 1

  If totalLike > 1 Then strLike = strLike & SQL_OR

  If firstWord Then

    spcPos = InStr(str, " ")

    If spcPos > 0 Then str = Left(str, spcPos - 1)

  End If



  strLike = strLike & "(" & fieldName & SQL_LIKE & str & ")"



  Return



End Function


'Populates a column of an ATCoGrid from an SQL WHERE clause
'sql       - SQL WHERE clause
'agd       - grid to populate
'col       - column of grid to populate (0..agd.cols - 1)
'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)

Public Sub GridColumnFromSQL(sql As String, agd As ATCoGrid, col&, fieldName$, Optional ByRef StartRow& = 1)
  Dim UcaseSQL$
  Dim valueSQL$
  Dim searchFor$
  Dim startSearch&, endSearch&
  Dim openParen&, closeParen&, equalPos&
  Dim notEqualPos&, likePos&, notParenPos&
  Dim Row&
  Dim curpos&, nextOr&
  
  Row = StartRow
  UcaseSQL = UCase(sql)
  searchFor = UCase(fieldName)
  startSearch = 1
RestartSearch:
  startSearch = InStr(startSearch, UcaseSQL, searchFor)
  endSearch = 0
  If startSearch > 0 Then
    'startSearch = startSearch + Len(searchFor)
    openParen = InStr(startSearch, UcaseSQL, "(")
    
    'Find first =, <>, or SQL_LIKE
    equalPos = InStr(startSearch, UcaseSQL, "=")
    notEqualPos = InStr(startSearch, UcaseSQL, "<>")
    likePos = InStr(startSearch, UcaseSQL, UCase(SQL_LIKE))
    
    notParenPos = equalPos
    
    If notEqualPos > 0 And (notEqualPos < notParenPos Or notParenPos = 0) Then notParenPos = notEqualPos
    
    If likePos > 0 And (likePos < notParenPos Or notParenPos = 0) Then notParenPos = likePos
    
    'If form is fieldname = 'Kansas'
    'or         fieldname LIKE 'K%', then search between quotes
    If notParenPos > 0 And (notParenPos < openParen Or openParen = 0) Then
      startSearch = InStr(notParenPos, UcaseSQL, "'")
      If startSearch > 0 Then
        endSearch = InStr(startSearch + 1, UcaseSQL, "'")
      Else
        startSearch = notParenPos + 1
      End If
    ElseIf openParen > 0 Then 'this looks like fieldname IN ('KS', 'VA'), so search between parens
      startSearch = openParen + 1
      endSearch = InStr(openParen, UcaseSQL, ")")
    End If
    If endSearch = 0 Then endSearch = Len(UcaseSQL)
    valueSQL = Mid(UcaseSQL, startSearch, endSearch - startSearch + 1)
    curpos = InStr(valueSQL, "'")
    While curpos > 0 And curpos < Len(valueSQL)
      nextOr = InStr(curpos + 1, valueSQL, "'")
      If nextOr < 1 Then nextOr = Len(valueSQL)
'      agd.TextMatrix(row, col) = ReplaceString(ReplaceString(Mid(sql, startSearch + curpos, nextOr - curpos - 1), "%", "*"), "_", "?")
      agd.TextMatrix(Row, col) = Mid(sql, startSearch + curpos, nextOr - curpos - 1)

      curpos = InStr(nextOr + 1, valueSQL, "'")
      Row = Row + 1
    Wend
    If likePos > 0 Then 'May have to look for multiple likes since they don't group nicely like IN does
      startSearch = endSearch
      GoTo RestartSearch
    End If
  End If
  StartRow = Row
  While Row < agd.rows
    agd.TextMatrix(Row, col) = ""
    Row = Row + 1
  Wend
End Sub
'Create a part of an SQL WHERE clause based on values in a combo box
'box       - single combo box
'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)
'
Public Function TextToSQL(strText As String, fieldName$) As String
   If Trim(strText) = "" Then
      TextToSQL = ""
      Exit Function
   End If
   
   TextToSQL = fieldName & " = '" & Trim(strText) & "'"
   
End Function
'Create a part of an SQL WHERE clause based on values in an array of checkboxes
'TextBox   - a text box containing a list of vbcrlf separated values
'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)
'inLike    - a string - probably SQL_IN or SQL_LIKE - to be used in constructing the SQL
Public Function TextListToSQL(strText As String, fieldName$, inLike$) As String
Dim OutString As String
Dim objParser As clsParser
Dim n As Long
Dim i As Long

  'First try to remove extra spaces and cr/lf that can clutter text from a list box
  On Error GoTo NothingLeft
  strText = Trim(strText)
  While Asc(Right(strText, 1)) < 33
    strText = Left(strText, Len(strText) - 1)
  Wend
  While Asc(strText) < 33
    strText = Mid(strText, 2)
  Wend
NothingLeft:
  If Trim(strText) = "" Then
    TextListToSQL = ""
    Exit Function
  End If
  strText = strText & vbCr
  On Error GoTo errTextListToSQL
                     
  Set objParser = New Parser.clsParser
  objParser.AssignProperties "ASCII Delimited", vbCr, ""
  objParser.TrimToken = True
  objParser.Suppress = True
  objParser.Parse strText
  
  If objParser.Count = 1 Then
    If objParser.GetToken(1) = "" Then
      TextListToSQL = fieldName & " = '" & objParser.GetToken(1) & "'"
    Else
      TextListToSQL = ""
    End If
  Else
    '
    ' Get first non blank token
    '
    For n = 1 To objParser.Count
      If objParser.GetToken(n) <> "" Then
        OutString = fieldName & " " & inLike & "('" & objParser.GetToken(n) & "'"
        i = n + 1
        GoTo AddRest
      End If
    Next
AddRest:
    '
    ' Append rest with commas
    '
    For n = i To objParser.Count
      If objParser.GetToken(n) <> "" Then
        OutString = OutString & "," & "'" & objParser.GetToken(n) & "'"
      End If
    Next
    OutString = OutString & ")"
  End If
  
  Set objParser = Nothing
  TextListToSQL = OutString
Exit Function
errTextListToSQL:

    MsgBox "Runtime error: modSQLinterface.TextListToSQL: " & vbCrLf & Err.description

End Function
'Create a part of an SQL WHERE clause based on values in an array of checkboxes
'box       - array of checkboxes
'fieldName - SQL name of field in database that values matching those in col may be in (e.g. Site.CountyCd)
'inLike    - a string - probably SQL_IN or SQL_LIKE - to be used in constructing the SQL
Public Function CheckboxesToSQL(box As Object, fieldName$, inLike$) As String
  Dim crit$, chk&, total&, totalAdded&
  Dim i As Long
  Dim TempString As String
  Dim multiSelection As Boolean
  
  
  crit = ""
  '
  ' Count total number of boxes checked and also
  ' check to see if a tag contains more than one
  ' selection. Multi selections are comma delimited.
  '
  multiSelection = False
  total = 0
  For chk = 0 To box.Count - 1
    If box(chk).value = 1 Then
       total = total + 1
       If InStr(1, box(chk).Tag, ",") > 0 Then
          multiSelection = True
       End If
    End If
  Next chk
  
  'if none or all are selected, then we don't need to include this criteria in SQL
  If total > 0 And total < box.Count Then
    crit = fieldName
    
    '
    If total > 1 Or inLike <> SQL_IN Then
      crit = crit & inLike & "("
    Else
      If multiSelection Then
        crit = crit & inLike & "("
      Else
        crit = crit & " = "
      End If
    End If
    totalAdded = 0
    For chk = 0 To box.Count - 1
      If box(chk).value = 1 Then
        '
        ' twa may 2000
        ' Handle the case where multiple values apply.
        ' Since some check boxs allow multiple settings
        ' multiple settings are allowed by entering
        ' the values comma delimited as the tag.
        '
        ' crit = crit & "'" & box(chk).Tag & "'"
        '
        TempString = box(chk).Tag
        i = 1
        While i <> 0
           i = InStr(1, TempString, ",")
           If i > 0 Then
              crit = crit & "'" & Mid(TempString, 1, i - 1) & "', "
              TempString = Mid(TempString, i + 1)
           Else
              crit = crit & "'" & TempString & "'"
              i = 0
           End If
        Wend
        
        totalAdded = totalAdded + 1
        If totalAdded < total Then crit = crit & ", "
      End If
    Next chk
    If total > 1 Or inLike <> SQL_IN Or multiSelection Then crit = crit & ")"
  End If
  CheckboxesToSQL = crit
End Function

'Sets a set of checkboxes from an SQL WHERE clause
'sql       - SQL WHERE clause
'box       - array of checkboxes
'fieldName - SQL name of field in database (e.g. Site.CountyCd)
Public Sub CheckboxesFromSQL(sql As String, box As Object, fieldName$)
  Dim UcaseSQL$, searchFor$
  Dim startSearch&, endSearch&
  Dim openParen&, closeParen&, equalPos&
  Dim Row&
  Dim chk&
  Dim commaPos&, chkTag As String
  
  Row = 1
  endSearch = 0
  UcaseSQL = UCase(sql)
  searchFor = UCase(fieldName)
  startSearch = InStr(UcaseSQL, searchFor)
  If startSearch > 0 Then
    startSearch = startSearch + Len(searchFor)
    openParen = InStr(startSearch, UcaseSQL, "(")
    equalPos = InStr(startSearch, UcaseSQL, "=")
    
    'If this looks like fieldname = 'Kansas' rather than fieldname LIKE/IN ('KS', 'VA')
    If equalPos > 0 And (equalPos < openParen Or openParen = 0) Then
      startSearch = InStr(equalPos, UcaseSQL, "'")
      If startSearch > 0 Then
        endSearch = InStr(startSearch + 1, UcaseSQL, "'")
      Else
        startSearch = equalPos + 1
      End If
    ElseIf openParen > 0 Then
      startSearch = openParen + 1
      endSearch = InStr(openParen, UcaseSQL, ")")
    End If
    If endSearch = 0 Then endSearch = Len(UcaseSQL)
    UcaseSQL = Mid(UcaseSQL, startSearch, endSearch - startSearch + 1)
    For chk = 0 To box.Count - 1
      With box(chk)
        chkTag = UCase(.Tag)
        commaPos = InStr(chkTag, ",")
        If commaPos > 0 Then chkTag = Left(chkTag, commaPos - 1)
        If InStr(UcaseSQL, "'" & chkTag & "'") > 0 Then
          .value = vbChecked
        Else
          .value = vbUnchecked
        End If
      End With
    Next chk
  End If

End Sub

'Public Function AddToWhere(oldvalue$, newvalue$, operator$) As String
'  If Len(newvalue) = 0 Then
'    AddToWhere = oldvalue
'  Else
'    If Len(oldvalue) = 0 Then
'      AddToWhere = "(" & newvalue & ")"
'    Else
'      AddToWhere = oldvalue & operator & "(" & newvalue & ")"
'    End If
'  End If
'End Function

' Function  - - - - - - - - - - - - - - - - - - - - - - - - -
' Name:     MakeWhere (2 arguments)
' Purpose:  Return a Where clause (minus the keyword Where)
'
'operator - and, or (paramater strings are anded or ored together)
'strValue - variable number of additional parameters to be joined together
'           by operator. Parameters of length zero will be skipped.
'
Public Function MakeWhere(operator$, ParamArray strValue()) As String
  Dim Val, nValues&, nValuesAdded&, retval$
  
  nValues = 0
  For Each Val In strValue
    If Val <> "" Then nValues = nValues + 1
  Next Val
  
  retval = ""
  nValuesAdded = 0
  
  If nValues > 0 Then
    For Each Val In strValue
      If Val <> "" Then
        If nValuesAdded > 0 Then retval = retval & operator
        If nValues = 1 Then
          retval = Val
        Else
          retval = retval & "(" & Val & ")"
        End If
        nValuesAdded = nValuesAdded + 1
      End If
    Next Val
  End If
  MakeWhere = retval
End Function

'spin is a string to insert before every . in crit
Public Function TransformWhere(crit$, spin$) As String
  Dim retval$, dotpos&, lastpos&
  lastpos = 0
  dotpos = InStr(crit, ".")
  While dotpos > 0
    If lastpos > 0 Then retval = retval & spin & "."
    retval = retval & Mid(crit, lastpos + 1, dotpos - lastpos - 1)
    lastpos = dotpos
    dotpos = InStr(dotpos + 1, crit, ".")
  Wend
  If lastpos > 0 Then retval = retval & spin & "."
  retval = retval & Mid(crit, lastpos + 1)
  TransformWhere = retval
End Function
'
'Public Function ReplaceString(source$, find$, replace$)
'  Dim retval$, findpos&
'  retval = source
'  findpos = InStr(retval, find)
'  While findpos > 0
'    retval = Mid(retval, 1, findpos - 1) & replace & Mid(retval, findpos + 1)
'    findpos = InStr(retval, find)
'  Wend
'  ReplaceString = retval
'End Function

Public Function ReplaceString(Source$, find$, replace$)
  Dim retval$, findpos&, lenFind&, lenReplace&
  retval = Source
  lenFind = Len(find)
  lenReplace = Len(replace)
  findpos = InStr(retval, find)
  While findpos > 0
    retval = Mid(retval, 1, findpos - 1) & replace & Mid(retval, findpos + lenFind)
    findpos = InStr(findpos + lenReplace, retval, find)
  Wend
  ReplaceString = retval
End Function

Public Sub PopulateSelectList(ATCo As Object, _
                         tableName As String, _
                         selectedName As String, _
                         Optional OrderBy As String = "", _
                         Optional criteria As String = "")
  Dim num&, selectedListIndex&
  Dim Ref As DataMgr.clsRefList
  Dim collRef As Collection
  Set Ref = New DataMgr.clsRefList
  Set collRef = New Collection
  Ref.GetRefList collRef, tableName, criteria, OrderBy
  
  With ATCo
    .ClearLeft
    
    num = 0
    If collRef.Count = 0 Then Exit Sub
    
    For Each Ref In collRef
        If Not .InRightList(Trim(Ref.RefNm)) Then
          .LeftItemFastAdd Trim(Ref.RefNm)
        End If
'        .LeftItemFastAdd Trim(Ref.RefCd) & " - " & Trim(Ref.RefNm)
    Next
  End With

End Sub

Public Sub PopulateCombo(cbo As ComboBox, _
                         tableName As String, _
                         selectedName As String, _
                         Optional OrderBy As String = "", _
                         Optional criteria As String = "")
  Dim num&, selectedListIndex&
  Dim Ref As DataMgr.clsRefList
  Dim collRef As Collection
  Set Ref = New DataMgr.clsRefList
  Set collRef = New Collection
  Ref.GetRefList collRef, tableName, criteria, OrderBy

  With cbo
    .clear
    num = 0
    If collRef.Count = 0 Then Exit Sub
    
    For Each Ref In collRef
      If IsNumeric(Trim(Ref.RefCd)) Then
        .List(num) = Trim(Ref.RefNm)
        .ItemData(num) = Trim(Ref.RefCd)
      Else
        .List(num) = Trim(Ref.RefCd) & " - " & Trim(Ref.RefNm)
        .ItemData(num) = num
      End If
      If .List(num) = selectedName Then selectedListIndex = num
      num = num + 1
    Next
    .ListIndex = selectedListIndex
    num = .ItemData(selectedListIndex)
    .Visible = True
  End With

End Sub

Function StrSplit(Source As String, delim As String, quote As String) As String
'##SUMMARY StrSplit - Returns leading portion of Source up to delimeter, _
 and returns Source without that portion. Quote specifies a particular _
 string that is exempt from the delimeter search.
'##SUMMARY   Example: StrSplit("Julie, Todd, Jane, and Ray", ",", "") = "Julie", and "Todd, Jane, and Ray" is returned as Source.
'##SUMMARY   Example: StrSplit("Julie, Todd, Jane, and Ray", ",", "Julie, Todd") = "Julie, Todd", and "Jane, and Ray" is returned as Source.
'##PARAM Source - string to be analyzed
'##PARAM delim - single-character string delimeter
'##PARAM quote - multi-character string delimeter
  Dim retval As String
  Dim i As Long
  Dim quoted As Boolean
  Dim trimlen As Long
  Dim quotlen As Long
  '##LOCAL retval - string to return as StrSplit
  '##LOCAL i - long character position of search through Source
  '##LOCAL quoted - Boolean whether quote was encountered in Source
  '##LOCAL trimlen - long length of delimeter, or quote if encountered first
  '##LOCAL quotlen - long length of quote
    
    Source = LTrim(Source) 'remove leading blanks
    quotlen = Len(quote)
    If quotlen > 0 Then
      i = InStr(Source, quote)
      If i = 1 Then 'string beginning
        trimlen = quotlen
        Source = Mid(Source, trimlen + 1)
        i = InStr(Source, quote) 'string end
        quoted = True
      Else
        i = InStr(Source, delim)
        trimlen = Len(delim)
      End If
    Else
      i = InStr(Source, delim)
      trimlen = Len(delim)
    End If
       
    If i > 0 Then 'found delimeter
      retval = Left(Source, i - 1) 'string to return
      Source = LTrim(Mid(Source, i + trimlen)) 'string remaining
      If quoted And Len(Source) > 0 Then
        If Left(Source, Len(delim)) = delim Then Source = Mid(Source, Len(delim) + 1)
      End If
    Else 'take it all
      retval = Source
      Source = "" 'nothing left
    End If
    
    StrSplit = retval
    
End Function

'
'' Subroutine ===============================================
'' Name:      RunQuery (1 arguments)
'' Purpose:   Loads and runs a query.
'' Arguments:
''   (1) Inp mdiMainForm - reference to the main swuds mdi interface.
''
'' Notes:
''
'' A call to the display will request that either
''   1. the main SWUDS mdi interface to retrieve and display
''      the grid report within the mdi frame.
''
''      using the call back to the mdi was the only way I could
''      come up with to get the grid report to display within the mdi
''      application.
''
''   2. Retrieve and display the output in Excel.
''
'Public Sub RunQuery(ReportOptions As Variant, _
'                    ReportOptionType As String)
'Dim objOutput As RetrievalEngine.clsExport
'Dim objReportGrid As frmReportGrid
'Dim dicReportOptions As Scripting.Dictionary
'
'  Select Case ReportOptionType
'    Case "dictionary"
'       Set dicReportOptions = ReportOptions
'    Case "inputfile"
'    Case "textbox"
'  End Select
''
'' First try to display the data.
''
'  With dicReportOptions
'    If .Exists(keyDisplayWith) Then
'      Select Case .item(keyDisplayWith)
'
'        Case "swuds":
'           Set objReportGrid = New frmReportGrid
'           Set objReportGrid.ReportOptions = dicReportOptions
'           objReportGrid.showit
'           Exit Sub
'
'        Case "excel":
'           Set objOutput = CreateObject("Retrievalengine.clsExcel")
'
'        Case "delimitedtextfile":
'           Set objOutput = CreateObject("Retrievalengine.clsDelimitedTextFile")
'
'        Case Else
'           MsgBox "Invalid display option: " & .Exists(keyDisplayWith)
'      End Select
'
'      Set objOutput.ReportOptions = dicReportOptions
'      objOutput.Display
'    End If
'    Exit Sub
'  End With
'  '
'  ' Else try exporting to a file
'  '
''  Set objOutput = CreateObject("retrievalengine.clsOutputProcesser")
''  Set objOutput.ReportOptions = dicReportOptions
''  objOutput.Export
''  Set objOutput = Nothing
'
'End Sub
'
''Public Sub PopulateCheckboxes(chkArray() As CheckBox, tableName$, selectedTags$)
''  Dim chk&, chk2&
''  Dim Ref As datamgr.clsRefList
''  Dim collRef As Collection
''  Set Ref = New datamgr.clsRefList
''  Set collRef = New Collection
''  Ref.GetRefList collRef, tableName'
'
''  chk = 0
''  For Each Ref In collRef
''    If chk > 0 Then Load chkArray(chk) 'chkArray.Count <= chk Then Load chkArray(chk)
''    With chkArray(chk)
''      .clear
''      .caption = Trim(Ref.RefNm)
''      .Tag = Trim(Ref.RefCd)
''      .Visible = True
''      If InStr(.Tag, selectedTags) > 0 Then .value = vbChecked Else .value = vbUnchecked
''    End With
''    chk = chk + 1
''  Next Ref
'  'For chk2 = chkArray.Count - 1 To chk Step -1
'  '  Unload chkArray(chk2)
'  'Next chk2
''End Sub