Tipp 0452 Daten aus einer Arbeitsmappe einlesen (ADO)
Autor/Einsender:
Datum:
  Angie
22.05.2005
Entwicklungsumgebung:   Excel 2000
Mittels ADO (Microsoft® ActiveX® Data Objects) ist es möglich, Daten aus geschlossenen (!) Arbeitsmappen auszulesen. Hier kann unterschieden werden, ob alle Daten im angegebenen Tabellenblatt ausgelesen werden sollen, oder nur ein bestimmter Bereich oder eine einzelne Zelle, oder ein Bereich, dem ein Name zugewiesen wurde.
In der SQL-Anweisung können zusätzlich weitere Kriterien/Bedingungen angegeben werden, z. B. dass nur Daten bestimmter Spalten ausgelesen werden sollen und/oder bestimmte Bedingungen erfüllt sein müssen.
Anmerkungen
Lese-/schreibgeschützte Arbeitsmappen
Arbeitsmappen, die mit einem Lese-/Schreibkennwort geschützt sind, können nicht mittels ADO bearbeitet werden!
Tabellenblattname
Für den Zugriff auf die Excel-Tabelle mittels ADO muss der Tabellenblattname mit dem $-Zeichen ergänzt werden und auch in eckigen Klammern ([ ]) gesetzt werden.
 
     [Tabellenname$]
     [Tabellenname$A1:C5]
     [Tabellenname$A2:A2]
 
Quellbereich
Wird als Quellbereich ein Bereich angegeben, das keine Daten enthält, so werden unter Umständen trotzdem Datensätze zurückgegeben. Dies ist z. B. dann der Fall, wenn im Quellbereich irgendwann Daten enthalten waren, diese jedoch lediglich mit der Taste Entf gelöscht wurden, und nicht die Zeile selbst (Zellen löschen... /Ganze Zeile).
Spaltenüberschriften
Wird als Quellbereich nur eine Zeile oder eine einzelne Zelle angegeben, muss beim Aufruf der folgenden Funktion für das Argument fColHDR False übergeben werden!
Funktion zum Auslesen der Daten (ADO)
Der Prozedur zum Auslesen der Daten aus der geschlossenen Arbeitmappe wird
  -  der Dateiname der geschlossenen Arbeitsmappe inkl. Pfad
  -  der SQL-String, in dem der Quellbereich angegeben ist und ggf. weitere Kriterien/Bedingungen
  -  ob Spaltenüberschriften vorhanden sind
  -  und ein Datenfeld für die Daten aus dem Quellbereich
übergeben.
Hier wird die GetRows-Methode verwendet, um die Datensätze aus dem Recordset in ein zweidimensionales Datenfeld zu kopieren. Damit die Daten in das Ziel-Tabellenblatt eingefügt werden können, müssen die Daten im Datenfeld anschließend transponiert.
Wenn bei der Ausführung der Funktion keine Fehler aufgetreten sind, ist der Rückgabewert der Funktion True, und im Datenfeld avarDataXL() sind die entsprechenden Daten aus dem Quellbereich enthalten.
 
Private Function GetDataFromWkb_ADO(ByVal strDBName As String, _
      ByVal strSQL As String, ByVal fColHDR As Boolean, _
      ByRef avarDataXL() As Variant) As Boolean

  Dim cnnADO        As ADODB.Connection
  Dim rstADO        As ADODB.Recordset
  Dim strExtProps   As String
  Dim avarDataRS    As Variant

  Dim nFieldsCnt    As Long
  Dim nRecordsCnt   As Long

  Dim nFld          As Long
  Dim nRec          As Long

  Dim blnData       As Boolean

  strExtProps = "Excel 8.0;"
  If Not fColHDR Then
    strExtProps = strExtProps & "HDR=No;"
  End If

  On Error GoTo err_GetValues

  Set cnnADO = New ADODB.Connection
  With cnnADO
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Extended Properties").Value = strExtProps
    .Open strDBName
  End With

  Set rstADO = New ADODB.Recordset
  With rstADO
    .ActiveConnection = cnnADO
    .CursorLocation = adUseClient
    .Source = strSQL
    .Open
  End With

  If Not (rstADO.EOF Or rstADO.BOF) Then
    avarDataRS = rstADO.GetRows()
    If IsArray(avarDataRS) Then
      nFieldsCnt = UBound(avarDataRS, 1)
      nRecordsCnt = UBound(avarDataRS, 2)

      ReDim avarDataXL(nRecordsCnt, nFieldsCnt)

      For nFld = 0 To nFieldsCnt
        For nRec = 0 To nRecordsCnt
          If Not IsNull(avarDataRS(nFld, nRec)) Then
            If IsDate(avarDataRS(nFld, nRec)) Then
              avarDataXL(nRec, nFld) = _
                  Format$(avarDataRS(nFld, nRec), "yyyy-mm-dd")
            Else
              avarDataXL(nRec, nFld) = avarDataRS(nFld, nRec)
            End If
            blnData = True
          End If
        Next
      Next
      Erase avarDataRS

      If blnData Then
        GetDataFromWkb_ADO = True
      Else
        MsgBox "Der Quellbereich enthält keine Daten!", _
             vbInformation, "VB-fun-Demo"
      End If
    End If
  Else
    MsgBox "Keine entsprechenden Datensätze gefunden!", _
         vbInformation, "VB-fun-Demo"
  End If

exit_Func:
  On Error Resume Next

  rstADO.Close
  Set rstADO = Nothing
  cnnADO.Close
  Set cnnADO = Nothing

  On Error GoTo 0
  Exit Function

err_GetValues:
  MsgBox "Fehler " & Err.Number & vbCrLf & Err.Description, _
        vbOKOnly + vbCritical, "VB-fun-Demo"
  Resume exit_Func
End Function
 
Beispiel-Aufruf
Wenn die Funktion zum Ermitteln der Daten erfolgreich ausgeführt werden konnte, werden in diesem Beispiel die Daten ab der nächsten freien Zeile im Ziel-Tabellenblatt eingefügt.
 
Public Sub Start_GetDataFromWkb_ADO()
  Dim strDBName     As String
  Dim strSource     As String
  Dim strSQL        As String
  Dim avarDataXL()  As Variant

  Dim optXLCalcMode As Long

  Dim wksDest       As Worksheet
  Dim nColDest      As Integer
  Dim nRowDest      As Long

  strDBName = ThisWorkbook.Path & "\TestDateien\Mappe1.xls"
  strSource = "[Tabelle1$]"
  strSQL = "SELECT * FROM " & strSource & ";"

  If Len(Dir$(strDBName)) = 0 Then
    MsgBox "Die Datei " & vbCrLf & strDBName & vbCrLf & _
          "existiert nicht!", vbInformation, "VB-fun-Demo"
    Exit Sub
  End If

  If GetDataFromWkb_ADO(strDBName, strSQL, True, avarDataXL()) Then
    With Application
      optXLCalcMode = .Calculation
      .Calculation = xlManual
      .EnableEvents = False
    End With

    nColDest = 1
    Set wksDest = ActiveWorkbook.Worksheets(1)

    On Error Resume Next
    With wksDest
      If Application.WorksheetFunction.CountA(.Cells) > 0 Then
        nRowDest = .Cells.Find(What:="*", After:=.Cells(1, 1), _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row + 1
      Else
          nRowDest = 2
      End If

      Err.Clear
      .Cells(nRowDest, nColDest).Resize( _
            UBound(avarDataXL, 1) + 1, _
            UBound(avarDataXL, 2) + 1).Value = avarDataXL

      If Err.Number = 0 Then
        .UsedRange.Columns.AutoFit

        MsgBox "Die Daten aus dem Quellbereich '" & strSource & _
            "' wurden eingelesen!", vbInformation, "VB-fun-Demo"

      Else
        MsgBox "Fehler " & Err.Number & vbCrLf & _
              Err.Description, vbCritical, "VB-fun-Demo"
      End If
    End With

    Erase avarDataXL
    Set wksDest = Nothing

    With Application
      .EnableEvents = True
      .Calculation = optXLCalcMode
    End With
  End If
  On Error GoTo 0
End Sub
 
Links zum Thema
How To Use ADO with Excel Data from Visual Basic or VBA
XL2000: "Invalid Use of New Keyword" Error Using ADODB Object Library
Eigene Links zum Thema
Daten aus einer geschlossenen Arbeitsmappe einlesen (DAO)
Daten aus einer geschlossenen Arbeitsmappe einlesen (Formeln)
Datumszuweisung in Tabellenzelle
Hinweis
Um diesen Tipp ausführen zu können, muss die Microsoft ActiveX Data Objects 2.x Library in das Projekt eingebunden werden.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
Excel-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (24,3 kB) Downloads bisher: [ 1708 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 29. Mai 2011