VBA - Auslesen bei wiederkehrendem Textformat
01.12.2014 11:05:39
eric
ich habe folgende Herausforderung:
Es sollen Daten aus mehreren Excel-Dateien ausgelesen werden und in einer anderen Excel-Datei ausgegeben werden. Mein Makro funktioniert soweit tadellos, wenn die Anzahl der auszulesenden Dateien fest ist:
Modul 1
Sub LeseDaten()
Dim sPath$, sFile$, ArrayData()
'Pfad evtl. anpassen
sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
With Tabelle1
.Range("B3:D41").ClearContents
ArrayData = .Range("B2:D40")
sFile = sPath & "pra_200005.xlsm"
oExAbfrage sFile, "200005G1$A:B", ArrayData, 1
sFile = sPath & "pra_200006.xlsm"
oExAbfrage sFile, "200006G1$A:B", ArrayData, 2
sFile = sPath & "pra_200007.xlsm"
oExAbfrage sFile, "200007G1$A:B", ArrayData, 3
.Range("B2:D40") = ArrayData
End With
End Sub
------------------------------------------------------------------------------------
Modul 2
Option Explicit
'Verweis auf Microsoft ActiveX Data Objects 6.0 Library
Private Const cProvider As String = "Provider=Microsoft.ACE.OLEDB.12.0; Extended Properties='Excel 12.0 Xml;HDR=YES';Data Source="
Private cnMDB As ADODB.Connection
Private adoRS As ADODB.Recordset
Private Sub Close_Datenbank()
On Error Resume Next
adoRS.Close
Set adoRS = Nothing
cnMDB.Close
Set cnMDB = Nothing
End Sub
Private Sub ADO_Connect(sFullPath$)
Set cnMDB = New ADODB.Connection
cnMDB.Open cProvider & sFullPath
End Sub
Private Sub Oben_Recordset(ByVal strSQL$, CursorType_ As CursorTypeEnum, LockType_ As _
LockTypeEnum)
Set adoRS = New ADODB.Recordset
With adoRS
.ActiveConnection = cnMDB
.CursorLocation = adUseClient
.CursorType = CursorType_
.LockType = LockType_
.Open strSQL
End With
End Sub
Function oExAbfrage(ByVal sFullPath$, strBereich$, ArrayData(), nCol&)
Dim strSQL$, n&, nBereiche&
If cnMDB Is Nothing Then ADO_Connect (sFullPath)
strSQL = "SELECT * FROM [" & strBereich$ & "]"
If adoRS Is Nothing Then
Oben_Recordset strSQL, adOpenForwardOnly, adLockReadOnly
End If
With adoRS
If Not .BOF Then
.MoveFirst
Do While Not .EOF
ArrayData(.Fields(0), nCol) = .Fields(1)
.MoveNext
Loop
End If
End With
Close_Datenbank
End Function
-------------------------------------------------------------------------------------
Nun wäre es wirklich traumhaft, wenn unabhängig von der Anzahl der auszulesenden Dateien (wächst im Laufe der Zeit) das Makro so ausgebaut werden könnte, dass anhand des Textformates ("pra_######.xlsm") JEDE Datei dieser Art, die sich im Sammelordner befindet, ausgelesen wird.
ACHTUNG: die 6-stellige Ziffer muss nicht zwangsläufig, wie die obigen 3, laufend sein.
Dementsprechend müsste auch die Größe der Tabelle, in die eingelesen wird, automatisch angepasst werden an die Anzahl der auszulesenden Dateien im Sammelordner.
Ich spring vor Freude im Dreieck, wenn mir jmd. weiterhelfen könnte.
Beste Grüße
Eric