Excel Dateien zusammenfügen mit einem Tool

Hallo,
Ich habe eine echt mühsame Aufgabe erhalten, die es mit VBA Kenntnissen bestimmt 1000 Mal vereinfachen lässt.
An 3 verschiedenen Orten/Pfade (leider geht es nicht anders) werden jeweils jeden Monat ein neuer Ordner mit dem Namen des Monats und dem Jahr erstell. In diesen Ordner sammeln sich bis Ende des Monats jeweils ca. 15-20 Exceldateien an.
Nun Muss ich momentan nach dem abgelaufenen Monat alle Exceldateien von den 3 Orten öffnen und alle in ein separates Excel zusammenfassen.
Die Excelsheets sind alle immer genau gleich aufgebaut. Immer sind die Spalten A bis E beschrieben.
Nun ist meine Frage, ob man ein Tool oder ähnliches machen könnte, wo ich dann Standardmässig die 3 Pfade der Ordner drin habe und ich dann direkt in meinem gewünschten Monatsorden die Dateien anwählen und zusammenfügen kann. Am Ende gibt es mir ein neues Excelsheet, wo alle gewünschten Dateien der 3 Ordner zusammengefasst sind. Abspeichern kann ich es dann im Anschluss, wo ich will.
Vielen Dank bereits im Voraus!!!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ich habe hier eine erste Variante:
Wie bekomme ich es nun hin, dass sich noch die zwei anderen Pfade ebenfalls öffnen und ich dann von allen 3 die Dateien auslesen kann?
Danke für eure Hilfe!

Function GetConnXLS(ByVal cFileName As String, _
Optional ByVal InformErrMSG As Boolean = False) As ADODB.Connection
On Error GoTo LOI:
Dim oConn As ADODB.Connection
Dim Ext As String, ConnStr As String
Set oConn = New ADODB.Connection
ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & cFileName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;"";"
oConn.Open ConnStr
Set GetConnXLS = oConn
LOI:
If Err.Number  0 Then
Set oConn = Nothing
If InformErrMSG Then
MsgBox "GetConnXLS" & ": " & Err.Number & " " & Err.Description, vbCritical
End If
End If
End Function

Sub test()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sh As Worksheet
Dim I As Long
Set cnn = GetConnXLS(ThisWorkbook.Path & "\" & "test.xlsx")
If cnn Is Nothing Then
MsgBox "Check lai co so du lieu"""
Exit Sub
End If
Set rst = cnn.Execute("SELECT 1 FROM DATA")
Set sh = Sheets("Master")
For I = 0 To rst.Fields.Count - 1
sh.Cells(3, I + 1).Value = rst.Fields(I).Name
Next I
I = sh.Range("A4").CopyFromRecordset(rst)
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub

Sub TestOpenFile()
Dim files As Variant
files = Application.GetOpenFilename(, , , , True)
If VarType(files) = vbBoolean Then Exit Sub
Dim I As Long
For I = LBound(files) To UBound(files)
Next I
Debug.Print VarType(files)
Debug.Print TypeName(files)
End Sub

Sub merge_all()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sh As Worksheet
Dim I As Long, k As Long, CountFiles As Long, J As Long
Dim files As Variant
files = Application.GetOpenFilename(, , , , True)
If VarType(files) = vbBoolean Then Exit Sub
Set sh = Sheets("Master")
For k = LBound(files) To UBound(files)
Set cnn = GetConnXLS(files(k))
If cnn Is Nothing Then
MsgBox "Check lai co so du lieu file: " & files(k)
Exit Sub
End If
Set rst = cnn.Execute("SELECT *,""" & files(k) & """ as [From File] FROM DATA")
CountFiles = CountFiles + 1
If CountFiles = 1 Then
For J = 0 To rst.Fields.Count - 1
sh.Cells(3, J + 1).Value = rst.Fields(J).Name
Next J
End If
I = I + sh.Range("A" & 4 + I).CopyFromRecordset(rst)
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
Next k
MsgBox "Done"
End Sub

Beliebteste Forumthreads (12 Monate)

Excel Dateien zusammenfügen mit einem Tool

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread