Public Function A2XADODFirst_V2( _
       psField1 As String, _
       psField2 As String, _
       psDomain As String, _
       Optional psDbs _
       As String = vbNullString, _
       Optional psCriteria _
       As String = vbNullString) _
       As Variant()
'   On Error GoTo HandleErr
 
    ' Verweis auf ActiveX Data Object 2.X muss gesetzt sein!
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
 
    Dim sSQL As String
    Dim vRet1 As Variant
    Dim vRet2 As Variant
    Dim vRet_Area(0 To 1) As Variant
 
    ' Rückgabewert initialisieren
    vRet = Null
 
    ' SQL-String zusammen schnipseln
    'erweitert für den zweiten Wert
    sSQL = "SELECT First ([" & psField1 & "]) AS RecCount1 , ([" & psField2 & _
      "]) AS RecCount2" & _
           "FROM [" & psDomain & "] "
 
    ' Falls Kriterium angegeben, WHERE-Klausel erstellen
    If Len(psCriteria) > 0 Then
        sSQL = sSQL & "WHERE " & psCriteria
    End If
    sSQL = sSQL & ";"
 
    ' Datenbank öffnen
    If Len(psDbs) > 0 Then
        Set cnn = New ADODB.Connection
        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=" & psDbs
    '
    'für VB6 deaktiviert - Jan Tappenbeck, 2007-10-24
    'Else
    '    Set cnn = CurrentProject.Connection
    End If
 
    ' Recordset öffnen
    Set rst = New ADODB.Recordset
 
    'debug.Print sSql
 
    rst.Open sSQL, cnn, adOpenStatic
 
    ' Falls DS vorhanden, ersten Wert übergeben
    If rst.RecordCount > 0 Then
        vRet1 = rst![RecCount1]
        vRet2 = rst![RecCount2]
    End If
 
    If Not IsNull(vRet1) And Not IsNull(vRet2) Then
        vRet_Area(0) = vRet1
        vRet_Area(1) = vRet2
        A2XADODFirst_V2 = vRet_Area
    End If
 
HandleExit:
    On Error Resume Next
    If Not rst Is Nothing Then rst.Close: Set rst = Nothing
    If Not cnn Is Nothing Then cnn.Close: Set cnn = Nothing
    Exit Function
 
HandleErr:
    Select Case Err.Number
    Case Else
Call MsgBox("Fehler beim Ermitteln eines Tabellenwertes !", "A2XADODFirst_V2")
    End Select
    Resume HandleExit
End Function

Private Function GetKoordWork(ByVal sPunktCode As String, _
                              ByVal lngCurrentID As Long, _
                              ByVal sName_R As String, _
                              ByVal sName_H As String, _
                              ByVal sTable As String) As Double()
 
    On Error GoTo Err_GetKoordWork
 
    GetKoordWork = A2XADODFirst_V2(sName_R, sName_H, sDBTable4Data, _
      sDBFileName, "ID_Station=" & CStr(lngCurrentID) & " AND GCode='" & _
      sPunktCode & "'")
 
    On Error GoTo 0
 
    Exit Function
 
Err_GetKoordWork:
 
    GetKoordWork(0) = 0#
    GetKoordWork(1) = 0#
    ShowErr "GetKoordWork"
    GoTo Exit_GetKoordWork
 
End Function

    GetKoordWork = A2XADODFirst_V2(sName_R, sName_H, sDBTable4Data, _
      sDBFileName, "ID_Station=" & CStr(lngCurrentID) & " AND GCode='" & _
      sPunktCode & "'")

Visual Basic 6.0 Grundkenntnisse und ansonsten alles rund um AutoCAD