Option Explicit
'content:
'-----public declarations
'-----Startfunktion
 
'Objects
Public objDataTier As CData
Public objLocalData As CLocal
Public objImportSpec As CImportSpec
Public objServiceSpec As CServiceSpec
Public objCompany As CCompany
Public objCustomer As CCustomer
Public objProduct As CProduct
Public objErr As CErrHandler
Public objUser As CUser
Public objAdresse As CAdresse
Public objMainMenu As CMainMenu
Public objMessage As CMessage
...
...
...

Public Function funRetrieveRSFilter(strTable As String, _
                                    Optional strFieldList As String = "*", _
                                    Optional strwhere As String = "", _
                                    Optional strOrderField As String = "", _
                                    Optional booDoEvents As Boolean = False) As _
                                    Variant
'   erzeugt 2-dimensionales Array der Form:
'   1. Zeile Header (=Feldnamen) / ab 2. Zeile Data
 
  Dim strSQL As String
  Dim rst As New ADODB.Recordset
  Dim aTmp() As Variant
  Dim i As Long
  Dim j As Long
  Dim l As Long
 
  strSQL = "SELECT " + strFieldList + " FROM " + strTable
 
  If strwhere <> "" Then
      strSQL = strSQL + " WHERE " + strwhere
  End If
 
  If strOrderField <> "" Then
      strSQL = strSQL + " ORDER BY " + strOrderField
  End If
 
  strSQL = strSQL + ";"
 
  Set rst = objDataTier.RetrieveRS(strSQL)
 
  With rst
 
    'Felder zählen:
    j = .Fields.count - 1
 
    'Datensätze zählen:
    Do While Not .eof
      .MoveNext
      l = l + 1
      If booDoEvents Then DoEvents
    Loop
 
    ReDim aTmp(l, j)
 
    For i = 0 To j
      aTmp(0, i) = .Fields(i).Name
    Next i
 
    'auf leer prüfen
    If Not .BOF Then .MoveFirst
    l = 1
    Do While Not .eof
      For i = 0 To j
        aTmp(l, i) = .Fields(i).Value
      Next i
      l = l + 1
      .MoveNext
      If booDoEvents Then DoEvents
    Loop
 
 
  End With
 
  funRetrieveRSFilter = aTmp
 
  Set rst = Nothing
End Function
 
 
 
 
 
Public Function funRetrieveSingleValue(strTable As String, strField As String, _
  strwhere As String) As Variant
 
  Dim strSQL As String
 
  strSQL = "SELECT " + strField + " FROM " + strTable
 
  If strwhere <> "" Then
    strSQL = strSQL + " WHERE " + strwhere
  End If
 
  strSQL = strSQL + ";"
 
  funRetrieveSingleValue = objDataTier.RetrieveSingleValue(strSQL)
 
 
End Function