Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
832to836
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
832to836
832to836
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten aus verschiedenen Arb.Mappen in eine Tabelle

Daten aus verschiedenen Arb.Mappen in eine Tabelle
04.01.2007 22:42:38
Sören
Hallo an alle hier im Forum,
ich habe vor 14 Tagen diese Frage gestellt und Fritz war so nett und hat mir geholfen. Leider kam ich erst heute wieder dazu die Dateien zu bearbeiten und es erscheint beim Ausführen des Scripts die Fehlermeldung "Fehler beim Kompilieren / Erwartet: Sup oder Function" Was bedeutet dies?
Vielen Dank für eure Hilfe
Sören
Hallo an alle im Forum,
ich benötige mal wieder eure Hilfe.
Und zwar habe ich einen Ordner mit verschiedenen Arbeitsmappen. (Jede Arbeitsmappe besteht aus 3 Tabellenblättern, wobei nur das erste jeweils benutzt wird.) Dieses Tabellenblatt ist eine Rechnung und in den Zellen B1 - B7 stehen die Adressdaten. Jetzt muss ich die einzelnen Adressen in einer neuen Tabelle zusammenfassen. Kennt jemand dafür einen Makro?
Vielen Dank
Sören
Hallo Sören,
vielleicht hilft dir dies weiter.
Die Pfade musst Du natürlich noch anpassen und die Datei, die Du bearbeitest, also die neue, darf nicht im gleiche Ordner stehen, wie die zu lesenden Dateien.
Gruß Fritz
Option Explicit
Declare

Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare

Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare

Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Sub xx()
Dim I&, J&, LZ&
Dim FoundFileNames() As String
Dim Ws1 As Worksheet
Dim WbTmp As Workbook
Dim WsTmp As Worksheet
Dim hFind&, hFile&, nFile&
Dim FD As WIN32_FIND_DATA
Dim PathName$, Pattern$
PathName = "D:\temp\herber\"        'Pfadname der Excel-Dateien
Pattern = "*.xls"                   ' Dateiendung
Set Ws1 = ActiveWorkbook.ActiveSheet
LZ = Ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
'Alle Excel-Dateien ermitteln
ReDim FoundFileNames(0)
hFile = FindFirstFile(PathName & Pattern, FD)
If hFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
Do
nFile = FindNextFile(hFile, FD)
If nFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
End If
Loop While nFile <> 0
End If
FindClose hFile
'Verarbeitung starten
For I = 0 To UBound(FoundFileNames) - 1
Set WbTmp = Workbooks.Open(FoundFileNames(I))
Set WsTmp = WbTmp.Sheets(1)
For J = 1 To 7
Ws1.Cells(LZ + 1, J) = WsTmp.Cells(J, 2)
Next
Set WsTmp = Nothing
WbTmp.Close
LZ = LZ + 1
Next
End Sub


Function ClearFileName(CDat)
Dim X&
X = InStr(1, CDat, Chr$(0))
If X > 0 Then
ClearFileName = Trim$(Left$(CDat, X - 1))
Exit Function
End If
ClearFileName = ""
End Function

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten aus verschiedenen Arb.Mappen in eine Tab
05.01.2007 00:08:50
Erich
Hallo Sören,
das liegt vermutlich daran, dass am Beginn des Codes durch die automatische Darstellung hier im Forum
ein paar Zeilen "zerrissen" sind. Das Declare gehört immer - getrennt durch ein Leerzeichen - direkt vor das folgende Wort.
Der Anfang des Codes sieht dann so aus:
Option Explicit
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Public Type FILETIME
dwLowDateTime As Long
usw.
Rückmeldung wäre nett! - Erich aus Kamp-Lintfort wünscht allen einen guten Start ins neue Jahr!
Anzeige
AW: Daten aus verschiedenen Arb.Mappen in eine Tab
05.01.2007 11:19:05
Sören
Hallo Erich, vielen Dank für deinen Hinweis. Ich habe es geändert und jetzt bleibt das Script hier hängen: PathName & ClearFileName)
Sub xx()
Dim I&, J&, LZ&
Dim FoundFileNames() As String
Dim Ws1 As Worksheet
Dim WbTmp As Workbook
Dim WsTmp As Worksheet
Dim hFind&, hFile&, nFile&
Dim FD As WIN32_FIND_DATA
Dim PathName$, Pattern$
PathName = "H:\Anna\Check-out\2007\Januar\" 'Pfadname der Excel-Dateien
Pattern = "*.xls" ' Dateiendung
Set Ws1 = ActiveWorkbook.ActiveSheet
LZ = Ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
'Alle Excel-Dateien ermitteln
ReDim FoundFileNames(0)
hFile = FindFirstFile(PathName & Pattern, FD)
If hFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName) (FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
Do
nFile = FindNextFile(hFile, FD)
If nFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
End If
Loop While nFile 0
End If
FindClose hFile
Kanst du mir sagen, was ich noch ändern muß?
Vielen Dank
Sören
Anzeige
AW: Daten aus verschiedenen Arb.Mappen in eine Tab
05.01.2007 14:18:40
Erich
Hallo Sören,
da hast du den Code wohl etwas geändert...
(FD.cFileName) gehört direkt hinter ClearFileName
Sieht dann so aus:
    FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Daten aus verschiedenen Arb.Mappen in eine Tab
05.01.2007 17:03:33
Sören
Hallo Erwin, in dem Beispiel ist es nur wegen mir auseinander gerutscht - ansonsten ist es hintereinander geschrieben, aber eben mit dieser Fehlermeldung.
Was kann es sonst sein?
Viele Grüße
Sören
Hier noch einmal das ganze Script:
Option Explicit
Declare

Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare 

Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare 

Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Sub xx()
Dim I&, J&, LZ&
Dim FoundFileNames() As String
Dim Ws1 As Worksheet
Dim WbTmp As Workbook
Dim WsTmp As Worksheet
Dim hFind&, hFile&, nFile&
Dim FD As WIN32_FIND_DATA
Dim PathName$, Pattern$
PathName = "H:\Anna\Check-out\2007\Januar\"       'Pfadname der Excel-Dateien
Pattern = "*.xls"                   ' Dateiendung
Set Ws1 = ActiveWorkbook.ActiveSheet
LZ = Ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
'Alle Excel-Dateien ermitteln
ReDim FoundFileNames(0)
hFile = FindFirstFile(PathName & Pattern, FD)
If hFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
Do
nFile = FindNextFile(hFile, FD)
If nFile > 0 Then
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
ReDim Preserve FoundFileNames(UBound(FoundFileNames) + 1)
End If
Loop While nFile <> 0
End If
FindClose hFile
'Verarbeitung starten
For I = 0 To UBound(FoundFileNames) - 1
Set WbTmp = Workbooks.Open(FoundFileNames(I))
Set WsTmp = WbTmp.Sheets(1)
For J = 1 To 7
Ws1.Cells(LZ + 1, J) = WsTmp.Cells(J, 2)
Next
Set WsTmp = Nothing
WbTmp.Close
LZ = LZ + 1
Next
End Sub

Function ClearFileName(CDat)
Dim X&
X = InStr(1, CDat, Chr$(0))
If X > 0 Then
ClearFileName = Trim$(Left$(CDat, X - 1))
Exit Function
End If
ClearFileName = ""
End Function

Anzeige
AW: Daten aus mehreren Mappen
05.01.2007 17:51:02
Erich
Hallo Sören,
jetzt habe ich das Makro selbst getestet und kann keinen Fehler finden.
Nach deiner Fehlermeldung scheint es bei dir die Funktion ClearFileName() nicht zu geben.
Sie steht aber unterhalb der Prozedur xx.
Versuch bitte mal, das Projekt zu kompilieren, nachdem du die Fehlerzeile
FoundFileNames(UBound(FoundFileNames)) = PathName & ClearFileName(FD.cFileName)
gekürzt hast hast zu
FoundFileNames(UBound(FoundFileNames)) = PathName
(Kompilieren geht im VBA-Editor-Menü mit Debuggen - Kompilieren von ...)
Gibt es eine Fehlermeldung?
Aber bitte das Makro so NICHT starten - das gäbe andere Fehler.
Rückmeldung wäre nett! - Grüße von Erich [nicht: ERWIN] aus Kamp-Lintfort
Anzeige
AW: Daten aus mehreren Mappen
05.01.2007 19:54:15
Sören
Hallo Erwin, mit der gekürzen Zeile gehts, aber in der 9. Zeile von unten:
End SubFunction ClearFileName(CDat)
kommt eine neue Fehlermeldung "Syntaxfahler"
Was ist das nun wieder?
Vielen Dank
Sören
AW: Daten aus mehreren Mappen
05.01.2007 23:16:21
Erich
Hallo Sören,
zunächst mal:
Ich hab doch geschrieben: "Grüße von Erich [nicht: ERWIN] aus Kamp-Lintfort"
Ich bin also der Erich, nicht der Erwin... ;-))
Wie ist denn End SubFunction ClearFileName(CDat) in eine Zeile zusammengerutscht?
Kein Wunder, dass VBA die Funktion ClearFileName nicht kennt...
Füg da mal mindestens eine, besser 2 Absatzmarken ein - dann wird daraus
End Sub
Function ClearFileName(CDat)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Daten aus mehreren Mappen
06.01.2007 11:52:38
Sören
Hallo Erich, bitte entschuldige den falschen Namen, aber ich war sicher so in das Problem vertieft, das ich ihn falsch geschrieben habe. Also nochmals sorry und vielen Dank für deine Hilfe. Es funktioniert jetzt alles.
Eine Sache würde ich gern noch mit einbauen. Denn den Pfad er Dateien muß ich im Makro ändern. Geht es, dass ich in meinem Tabellenblatt (von dem aus ich das Makro starte) in die Zelle B1 den Pfad eintrage bzw. ändere und das Makro sich die Angaben von dort holt?
Das Makro ist wirklich sehr hilfreich für mich, vielen Dank.
Sören
AW: Daten aus mehreren Mappen
07.01.2007 22:40:49
Erich
Hallo Sören,
dazu brauchst du vermutlich (ungetestet) nur eine Zeile oben in xx zu ändern, von
PathName = "D:\temp\herber\"        'Pfadname der Excel-Dateien
in
PathName = Cells(1, 2)         'Pfadname der Excel-Dateien
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Daten aus mehreren Mappen
08.01.2007 11:11:21
Sören
Hallo Erich, es funktioniert.
Vielen Dank und viele Grüße
Sören

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige