Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1380to1384
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Dateien aus mehreren Ordnern oeffnen

Makro Dateien aus mehreren Ordnern oeffnen
16.09.2014 16:06:34
Joachim
Hallo zusammen,
sitze gerade vor einem VBA Problem. Und zwar habe ich ein Makro, das in einem bestimmten Ordner alle darin enthaltenen Excel Dateien nacheinander oeffnet und jeweils aus jeder Datei bestimmte Zellen in eine Datenbank kopiert.
Nun soll das Makro nicht nur die Dateien in dem einen Ordner oeffnen und entsprechende Zellen kopieren, sondern einen weiteren Ordner oeffnen und dort das gleiche durchfuehren.
Insgesamt sollen in der Datenbank also alle bestimmten Zellen aus allen Dateien, die in beiden Ordnern enthalten sind, auftauchen.
Die Dateipfade der Ordner die geoeffnet werden sollen sind dabei:
C:\Users\Databank Produkt 1\
C:\Users\Databank Produkt 2\
Anbei habe ich noch das Makro zur veranschaulichung hochgeladen. Momentan oeffnet dieses Makro nur alle Dateien aus dem Ordner: C:\Users\Databank Produkt 1\
https://www.herber.de/bbs/user/92663.doc
Waere super, wenn mir da einer von euch weiterhelfen koennte!
Vielen Dank im Voraus!
Viele Gruesse

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

Betreff
Datum
Anwender
Anzeige
AW: Makro Dateien aus mehreren Ordnern oeffnen
16.09.2014 16:19:11
ChrisL
Hi Joachim
Netter Hinweis für nächstes mal: Bitte keine Word-Dateien sondern eine Excel-Beispielmappe.
Den Code konnte ich nicht testen aber ich denke so müsste es gehen:
Sub Machmal()
Call InsertData("C:\Users\Databank Produkt 1\")
Call InsertData("noch ein Pfad")
End Sub
Private Sub InsertData(sPfad As String)
Application.DisplayAlerts = False
Dim Pfad As String, strFile As String
Dim Quelldatei As Workbook
Dim Q1 As Worksheet
Dim Datenbank As Worksheet
Dim i As Integer, ende As Integer
Pfad = sPfad
strFile = Dir$(Pfad & "*.xlsm")
i = 5
Set Datenbank = ThisWorkbook.Worksheets(1)
ende = Datenbank.Cells(Rows.Count, 1).End(xlUp).Row
Datenbank.Range("A5:BN10000" & ende).ClearContents
Do Until strFile = vbNullString
Set Datenbank = ThisWorkbook.Worksheets(1)
Set Quelldatei = Workbooks.Open(Pfad & strFile, ReadOnly:=True, UpdateLinks:=0)
Set Q1 = Quelldatei.Sheets("Uebertrag")
Datenbank.Cells(i, 1) = Q1.Range("A5")      'Line
Datenbank.Cells(i + 1, 1) = Q1.Range("A6")  'Line
Datenbank.Cells(i + 2, 1) = Q1.Range("A7")  'Line
Datenbank.Cells(i + 3, 1) = Q1.Range("A8")  'Line
Datenbank.Cells(i + 4, 1) = Q1.Range("A9")  'Line
Datenbank.Cells(i + 5, 1) = Q1.Range("A10") 'Line
Datenbank.Cells(i + 6, 1) = Q1.Range("A11") 'Line
Datenbank.Cells(i, 2) = Q1.Range("B5")      'Month
Datenbank.Cells(i + 1, 2) = Q1.Range("B6")  'Month
Datenbank.Cells(i + 2, 2) = Q1.Range("B7")  'Month
Datenbank.Cells(i + 3, 2) = Q1.Range("B8")  'Month
Datenbank.Cells(i + 4, 2) = Q1.Range("B9")  'Month
Datenbank.Cells(i + 5, 2) = Q1.Range("B10") 'Month
Datenbank.Cells(i + 6, 2) = Q1.Range("B11") 'Month
Quelldatei.Close
Set Q1 = Nothing
Set Quelldatei = Nothing
strFile = Dir$
i = i + 7
Loop
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub

cu
Chris

Anzeige
AW: Makro Dateien aus mehreren Ordnern oeffnen
17.09.2014 15:33:18
Joachim
Hallo Chris,
vielen Dank fuer deinen Vorschlag. Dieser funktioniert, jedoch habe ich das Problem, dass das Makro zunaechst die Daten aus dem ersten Pfad ins die Datenbank schreibt und danach diese mit den Daten aus dem zweiten Pfad ueberschreibt. Somit habe ich am ende nur die Daten aus den Dateien, die im zweiten Pfad abgelegt wurden in der Datenbank.
Ich moechte aber, dass das Makro nachdem es die Daten aus den Dateien, die im ersten Pfad abgelegt sind, in die Datenbank geschrieben hat, die Daten aus den Dateien aus dem zweiten Pfad anhaengt.
Weist du da vllt noch ne Loesung? Das waere super!
Vielen Dank im Voraus.
Datenbank: https://www.herber.de/bbs/user/92687.xlsm
Produkt 1: https://www.herber.de/bbs/user/92688.xlsm
Produkt 2: https://www.herber.de/bbs/user/92690.xlsm
Viele Gruesse
Joachim

Anzeige
AW: Makro Dateien aus mehreren Ordnern oeffnen
18.09.2014 14:35:11
ChrisL
Hi Joachim
Hier eine neue Version...
Sub MergeOfDatabases()
ThisWorkbook.Worksheets(1).Range("A5:BN" & ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End( _
xlUp).Row).ClearContents
Call InsertData("Pfad 1")
Call InsertData("Pfad 2")
End Sub
Sub InsertData(sPfad As String)
Application.DisplayAlerts = False
Dim Pfad As String, strFile As String
Dim Quelldatei As Workbook
Dim Q1 As Worksheet
Dim Datenbank As Worksheet
Dim i As Integer
Pfad = sPfad
strFile = Dir$(Pfad & "*.xlsm")
i = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
Set Datenbank = ThisWorkbook.Worksheets(1)
Do Until strFile = vbNullString
Set Datenbank = ThisWorkbook.Worksheets(1)
Set Quelldatei = Workbooks.Open(Pfad & strFile, ReadOnly:=True, UpdateLinks:=0)
Set Q1 = Quelldatei.Sheets("Uebertrag")
Datenbank.Cells(i, 1) = Q1.Range("A5")      'Line
Datenbank.Cells(i + 1, 1) = Q1.Range("A6")  'Line
Datenbank.Cells(i + 2, 1) = Q1.Range("A7")  'Line
Datenbank.Cells(i + 3, 1) = Q1.Range("A8")  'Line
Datenbank.Cells(i + 4, 1) = Q1.Range("A9")  'Line
Datenbank.Cells(i + 5, 1) = Q1.Range("A10") 'Line
Datenbank.Cells(i + 6, 1) = Q1.Range("A11") 'Line
Datenbank.Cells(i, 2) = Q1.Range("B5")      'Month
Datenbank.Cells(i + 1, 2) = Q1.Range("B6")  'Month
Datenbank.Cells(i + 2, 2) = Q1.Range("B7")  'Month
Datenbank.Cells(i + 3, 2) = Q1.Range("B8")  'Month
Datenbank.Cells(i + 4, 2) = Q1.Range("B9")  'Month
Datenbank.Cells(i + 5, 2) = Q1.Range("B10") 'Month
Datenbank.Cells(i + 6, 2) = Q1.Range("B11") 'Month
Quelldatei.Close
Set Q1 = Nothing
Set Quelldatei = Nothing
strFile = Dir$
i = i + 7
Loop
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub

cu
Chris

Anzeige
AW: Makro Dateien aus mehreren Ordnern oeffnen
24.09.2014 16:44:18
Joachim
Hallo Chris,
vielen Dank fuer deinen neuen Vorschlag! Er laeuft perfekt und das Makro macht jetzt genau das, was ich mir gewuenscht habe.
Hast mir damit wirklich weitergeholfen!!
Danke nochmal!
Viele Gruesse
Joachim

AW: Makro Dateien aus mehreren Ordnern oeffnen
16.09.2014 16:20:58
Rudi
Hallo,
Schema:
  Pfad = Array("C:\Users\Databank Produkt 1\", "C:\Users\Databank Produkt 2\")
For x = 0 To 1
strFile = Dir$(Pfad(x) & "*.xlsm")
Do While strFile  ""
Set wkb = Workbooks.Open(Pfad(x) & strFile)
'mach was
wkb.Close False
strFile = Dir
Loop
Next x

Gruß
Rudi

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige