Mehrere Dateien in eine Datei einfügen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Mehrere Dateien in eine Datei einfügen
von: Michael Filipp
Geschrieben am: 08.03.2005 20:33:46
Hallo,
ich habe ein kleines VBA Problem.
Situation:
Ich habe in einem bestimmten Verzeichnis mehrere (ca. 150) Dateien.
Jede Datei hat 4 Arbeitsblätter und ein zusätzliches verstecktes Blatt.
Die Mappe hat einen Passwortschutz, aber das versteckte Blatt kann man auch so anzeigen lassen
1 Aufgabe:
Ich muss ein Master Dokument erstellen und von jeder Datei auf dem versteckten Blatt NUR die dritte Zeile kopieren und sie jeweils im Masterdokument eintragen.
Die Änderungen in den Quelldateien sollen nicht gesichert werden.
Das soll so lange laufen, bis alle Dateien abgearbeitet sind.
Also so lange dass ich alle Zeilen, also im Idealfall 150 Einträge in dem Masterdokument habe.
Die Steigerung: Es soll auch noch ein Zähler angegeben werden, wie viele Dateien eingebunden wurden.
2 Aufgabe (high level):
S.O. ABER es gibt verschiedene Versionen der gleichen Datei.. Also XY.xls und XY_V2.xls ???
Könnte mir bitte jemand helfen ????
Ich verzweifele !!!
DANKE ..

Bild

Betrifft: AW: Mehrere Dateien in eine Datei einfügen
von: Josef Ehrensberger
Geschrieben am: 08.03.2005 22:01:36
Hallo Michael!
Ungetestet, sollte aber laufen!
Kopiere den Code in ein allgemeines Modul deiner Masterdatei.
Den Pfad zu deinen dateien anpassen!


      
Sub Daten_Auslesen()
'by J.Ehrensberger

Dim fSearch As FileSearch
Dim wkb As Workbook, wks As Worksheet, wsData As Worksheet
Dim strPath As String
Dim iCnt As Integer, lRow As Long
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = 
False
.EnableEvents = 
False
.DisplayAlerts = 
False
.Calculation = xlCalculationManual
End With
Set wsData = Sheets("Tabelle1")  'Tabelle zum Eintragen der Daten

strPath = 
"D:\Temp"  'Pfad des Ordners mit den Dateien - anpassen

Set fSearch = Application.FileSearch
With fSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = 
False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeExcelWorkbooks
.Execute
   
For iCnt = 1 To .FoundFiles.Count
   
   
Set wkb = Workbooks.Open(.FoundFiles(iCnt))
   
      
For Each wks In wkb.Worksheets
         
If wks.Visible <> xlSheetVisible Then
         lRow = lRow + 1
         wsData.Rows(lRow).Value = wks.Rows(
"3").Value
         
Exit For
         
End If
      
Next
      
   wkb.Close 
False
   
   
Set wkb = Nothing
   
   
Next
End With
Set fSearch = Nothing
ERRORHANDLER:
With Application
.ScreenUpdating = 
True
.EnableEvents = 
True
.DisplayAlerts = 
True
.Calculation = xlCalculationAutomatic
End With
If lRow > 0 Then MsgBox "Es wurden " & lRow & " Datensätze importiert!" & _
                                                   Space(15), vbInformation
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0


Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild

Betrifft: AW: Mehrere Dateien in eine Datei einfügen
von: Michael
Geschrieben am: 09.03.2005 08:23:45
Morgen Sepp,
SUPER herzlichen Dank. Er kopiert und meldet... aber es sind nur „0-en“ eingetragen und keine Werte...
Leider habe ich noch ein weiteres Problem:
Es handelt sich um 5 Arbeitsblätter und das 6 ist ausgeblendet.... und es sollen nur die Inhalte also 3. Zeile aus dem versteckten Blatt kopiert werden.
Kannst Du mir dieses Problem auch lösen ???
Zu der Versionierung... ist es möglich nur jeweils die „höchste“ Version der Datei einzulesen.
Danke noch mal für die Hilfe.
Wünsche dir einen schönen Tag
Gruss
Michael
Bild

Betrifft: AW: Mehrere Dateien in eine Datei einfügen
von: Josef Ehrensberger
Geschrieben am: 10.03.2005 01:01:43
Hallo Michael!
Warum du nur Nullen eingetragen bekommst, kann ich mir nicht erklären!
Hab den Code getestet, und er funktioniert ausgezeichnet.
Hier eine Versionsbezogene ermittlung der Daten.
Ich gehe davon aus, das vor der Versionsbezeichnung immer ein "_" steht!


      
Option Explicit
'Variablen auf Modulebene---------------------------------------
Dim fSearch As FileSearch
Dim wkb As Workbook, wks As Worksheet, wsData As Worksheet
Dim lRow As Long
'---------------------------------------------------------------

Sub Daten_Auslesen()
Dim tmp As String, strPath As String
Dim iCnt As Integer, n As Integer
Dim arrFile() As Variant
Dim fso
'by J.Ehrensberger
'
'Auslesen von Dateien eines Verzeichnisses
'Wenn von einer Datei mehrere Versionen vorhanden sind,
'nur die neueste Version auslesen

'Erkennungszeichen ist ein "_" vor der Versionsbezeichnung

On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = 
False
.EnableEvents = 
False
.DisplayAlerts = 
False
.Calculation = xlCalculationManual
End With
lRow = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsData = Sheets("Tabelle1")  'Tabelle zum Eintragen der Daten

strPath = 
"D:\Temp"  'Pfad des Ordners mit den Dateien - anpassen

Set fSearch = Application.FileSearch
With fSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = 
False  '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeExcelWorkbooks
.Execute sortorder:=msoSortOrderDescending
ReDim arrFile(.FoundFiles.Count - 1)
   
'Einlesen der Dateinamen in Array
   For iCnt = 1 To .FoundFiles.Count
   arrFile(iCnt - 1) = fso.getbasename(.FoundFiles(iCnt))
   
Next
   
   
'Schleife(1) start. Elemente des Arrays durchlaufen
   For n = 0 To UBound(arrFile)
      
'Wenn "_" im Dateinamen, dann
      If InStr(1, arrFile(n), "_") > 0 Then
      
'Funktion zum auslesen der Datei aufrufen
      getData (.FoundFiles(n + 1))
      
'Dateiname bis zum "_" ermitteln
      tmp = Left(arrFile(n), InStr(1, arrFile(n), "_") - 1)
         
'Schleife(2) start
         Do
            
'Wenn die nächste Datei den selben namen hat, dann
            If Left(arrFile(n + 1), Len(tmp)) = tmp Then
            
'Zähler Schleife(1) inkrementieren
            n = n + 1
               
If n > UBound(arrFile) Then Exit For
            
'Wenn name nicht gleich, dann
            Else
               
'Schleife(2) verlassen
               Exit Do
            
End If
         
'Wendepunkt Schleife(2)
         Loop
      
'Wenn "_" nicht im Dateinamen gefunden, dann
      Else
      
'Funktion zum auslesen der Datei aufrufen
      getData (.FoundFiles(n + 1))
      
End If
   
'Wendepunkt Schleife(1)
   Next
End With
ERRORHANDLER:
Set fSearch = Nothing
Set fso = Nothing
With Application
.ScreenUpdating = 
True
.EnableEvents = 
True
.DisplayAlerts = 
True
.Calculation = xlCalculationAutomatic
End With
If lRow > 0 Then MsgBox "Es wurden " & lRow & " Datensätze importiert!" & _
                                                   Space(15), vbInformation
End Sub

Function getData(strFile As String)
'Auslesen der Daten aus Datei

   
'Datei öffnen
   Set wkb = Workbooks.Open(strFile)
      
'Alle Tabellen durchlaufen
      For Each wks In wkb.Worksheets
         
'Wenn Tabelle ausgeblendet, dann
         If wks.Visible <> xlSheetVisible Then
         
'Zeilenzähler für "Tabelle1" inkrementieren
         lRow = lRow + 1
         
'Zeile 3 aus Tabelle in "Tabelle1" schreiben
         wsData.Rows(lRow).Value = wks.Rows("3").Value
         
'Schleife verlassen
         Exit For
         
End If
      
Next
   
'Datei schliessen
   wkb.Close False
   
Set wkb = Nothing
   
End Function 

     Code eingefügt mit Syntaxhighlighter 3.0



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild

Betrifft: AW: Mehrere Dateien in eine Datei einfügen
von: Ralf (Schwabenland)
Geschrieben am: 09.03.2005 14:59:11
Hallo Michael,
kann dir zumindest eine Teillösung anbieten, da ich das Gleiche bei mir nutze. Nicht schön, aber funzt. Habe dir ein ZIP-File hochgeladen. In dem sind 7 Dateien. Du musst alles in C:\Temp_1 entpacken und dann die Datei "alle_xls_öffnen.xls" im Verzeichnis C:\Temp_1\Temp_1 mal springen lassen. Er kopiert aus allen Dateien, die kein "_" Unterstrich im Namen haben. Das ist bei uns so eingerichtet, dass alle Dateien, die als Folgeversionen abgelegt werden, einen Unterstrich im Namen haben. Damit kann ich ganz leicht drauf zu greifen. Du musst noch die Pfade, Dateinamen und Tabellenblattnamen anpassen.
Hier die Date:
https://www.herber.de/bbs/user/19404.zip
Hoffe es hilft.
Gruß
Ralf
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Mehrere Dateien in eine Datei einfügen"