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.
|
|
|
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
|
|
|
|
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
|
|
|
|
|
|
|
|
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: [ 1816 ]
|
|
|