Microsoft Excel

Herbers Excel/VBA-Archiv

Makro Dateien aus mehreren Ordnern oeffnen

Betrifft: Makro Dateien aus mehreren Ordnern oeffnen von: Joachim Guenthner
Geschrieben am: 16.09.2014 16:06:34

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

  

Betrifft: AW: Makro Dateien aus mehreren Ordnern oeffnen von: ChrisL
Geschrieben am: 16.09.2014 16:19:11

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


  

Betrifft: AW: Makro Dateien aus mehreren Ordnern oeffnen von: Joachim Guenthner
Geschrieben am: 17.09.2014 15:33:18

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


  

Betrifft: AW: Makro Dateien aus mehreren Ordnern oeffnen von: ChrisL
Geschrieben am: 18.09.2014 14:35:11

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


  

Betrifft: AW: Makro Dateien aus mehreren Ordnern oeffnen von: Joachim Guenthner
Geschrieben am: 24.09.2014 16:44:18

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


  

Betrifft: AW: Makro Dateien aus mehreren Ordnern oeffnen von: Rudi Maintaire
Geschrieben am: 16.09.2014 16:20:58

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


 

Beiträge aus den Excel-Beispielen zum Thema "Makro Dateien aus mehreren Ordnern oeffnen"