Office: (Office 2013) Ordner durchsuchen und xlsx auflisten

xlph · 12. Februar 2016

In Tabelle1 jeder Datei befindet sich dann z.B...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Heißt das betreffende Blatt in jeder Datei "Tabelle1" oder meinst du
das Blatt an 1. Position (von Links)?

Karsten68 · 12. Februar 2016

- Heißt das betreffende Blatt in jeder Datei "Tabelle1" - ja so ist es!

Ich habe jetzt selbst auch etwas probiert:

getWorkbookCellData = ExecuteExcel4Macro("'E:\Projekte\Aktuell\16001_Uslar_Wiesenstraße\[16001.xlsm]Tabelle1'!" & Range("A1").Address(True, True, -4150))

Das läuft soweit, dass jeweils nur die Zelle A1 aus der 16001 aufgelistet wird.
Ist ja logisch.

Müsste also die feste Pfadangabe, durch eine variable, die ja im übrigen Code irgendwo drinsteckt, ersetzen. Aber da bin ich aufgeschmissen...

xlph · 12. Februar 2016

Code:

Public Sub XLPH()

Dim fso As Object
Dim colPath As Collection
Dim strPathStart As String

Dim icolPath As Long

Dim avntData() As Variant

strPathStart = "E:\Test" ' Anpassen ****

Set colPath = New Collection

Set fso = CreateObject("Scripting.FileSystemObject")
Call ReadFilePaths(fso, strPathStart, colPath, ".xlsx")
Set fso = Nothing

If colPath.Count > 0 Then

ReDim avntData(1 To colPath.Count + 1, 1 To 5)

avntData(1, 1) = "Datei-Pfad"
avntData(1, 2) = "[A2]"
avntData(1, 3) = "[A3]"
avntData(1, 4) = "[A4]"
avntData(1, 5) = "[A5]"

Application.ScreenUpdating = False

For icolPath = 1 To colPath.Count
avntData(icolPath + 1, 1) = colPath(icolPath)
avntData(icolPath + 1, 2) = getCellLink(colPath(icolPath), "Tabelle1", "A2")
avntData(icolPath + 1, 3) = getCellLink(colPath(icolPath), "Tabelle1", "A3")
avntData(icolPath + 1, 4) = getCellLink(colPath(icolPath), "Tabelle1", "A4")
avntData(icolPath + 1, 5) = getCellLink(colPath(icolPath), "Tabelle1", "A5")
Next

With Tabelle1
.UsedRange.Clear
With .Range("A1").Resize(UBound(avntData, 1), UBound(avntData, 2))
.Formula = avntData()
.Formula = .Value
End With
End With

Application.ScreenUpdating = True

End If

Set colPath = Nothing

End Sub

Public Sub ReadFilePaths(fso As Object, strPath As String, colPath As Collection, Optional strFileType As String)
Dim fo As Object, fi As Object, sfo As Object

Set fo = fso.GetFolder(strPath)
For Each fi In fo.Files
If LCase$(fi.Name) Like "*" & strFileType Then
colPath.Add fi.Path
End If
Next
Set fi = Nothing

For Each sfo In fo.SubFolders
Call ReadFilePaths(fso, sfo.Path, colPath, strFileType)
Next

Set fo = Nothing

End Sub

Private Function getCellLink(strPath As String, strWorksheetName As String, strCellAddress As String) As String
Dim strPathF As String, strFileF As String
strPathF = Left$(strPath, InStrRev(strPath, "\"))
strFileF = Mid$(strPath, InStrRev(strPath, "\") + 1)
getCellLink = "='" & strPathF & "[" & strFileF & "]" & strWorksheetName & "'!" & strCellAddress
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Karsten68 · 12. Februar 2016

In den Datenzellen erhalte ich BEZUG als Fehlermeldung
Wenn aber eine Ursprungsdatei offen ist, werden deren Daten übernommen?

Karsten68 · 12. Februar 2016

In den Datenzellen erhalte ich BEZUG als Fehlermeldung
Wenn aber eine Ursprungsdatei offen ist, werden deren Daten übernommen?
- aus versehen zweimal gepostet -

xlph · 13. Februar 2016

Schon mal daran gedacht, dass deine Quell-Dateien in den entsprechenden Zellen der "Tabelle1" diesen Fehler aufweisen?

Karsten68 · 14. Februar 2016

Dort sind keine Fehlermeldungen. Die Werte dort, sind z.Zt. noch von Hand eingetragen.

Macht aber nichts...

Mir ist sowieso übers Wochenende bewusst geworden, dass die Werte der Quelldateien anders in die Auflistung kommen müssen. Nämlich dann wenn die Quelldatei geschlossen wird. Die Codes dafür habe ich selbst hinbekommen.*biggrin.gif*

So ist es bestens. Der Code von XLPH durchforstet die Unterordner und stellt eine Liste der darin enthaltenen xlDateien her. Aus dieser Liste kann ich die einzelnen Dateien aufrufen. Nach deren Bearbeitung werden bestimmte Werte in die Liste zurückgeschrieben.

Danke für die Hilfe.

Karsten68 · 30. März 2017

Hallo zusammen, ich grabe diesen Thread nochmal aus.

"Auflistung der in einem WinOrdner enthaltenen ExcelDateien mit Ausgabe bestimmter Zellwerte in die Liste"

Mit Eurer Hilfe läuft mein Vorhaben seit einem Jahr hervorragend.
Problem nun - mittlerweile sind ne ganze Menge Dateien im Ordner, so dass die Liste unübersichtlich wird.

Lösung wäre nur bestimmte Ordner aufzulisten... etwa so
If Zelle A5(des jeweiligen Ordners) > 10 dann auflisten sonst nicht

Ich hatte angefangen das in der Art in den Code einzubauen, bekomme es aber nicht zum laufen, dafür verstehe ich dann wieder doch zu wenig vom Ganzen. Hier nochmal der jetzige Code:

Code:

Public Sub XLPH()

Dim fso As Object
Dim colPath As Collection
Dim strPathStart As String

Dim icolPath As Long

Dim avntData() As Variant

strPathStart = "E:ProjekteAktuell" ' Anpassen ****

Set colPath = New Collection

Set fso = CreateObject("Scripting.FileSystemObject")
Call ReadFilePaths(fso, strPathStart, colPath, ".xls") 'xls oder anderes Dateiformat
Set fso = Nothing

If colPath.Count > 0 Then

ReDim avntData(1 To colPath.Count + 1, 1 To 6)

avntData(1, 1) = "Datei-Pfad"
avntData(1, 2) = "Projekt"
avntData(1, 3) = "Status"
avntData(1, 4) = "Summe"
avntData(1, 5) = "Std"
avntData(1, 6) = "Mat"

Application.ScreenUpdating = False

For icolPath = 1 To colPath.Count

avntData(icolPath + 1, 1) = colPath(icolPath)
avntData(icolPath + 1, 2) = getCellLink(colPath(icolPath), "Daten", "A2")
avntData(icolPath + 1, 3) = getCellLink(colPath(icolPath), "Daten", "A7")
avntData(icolPath + 1, 4) = getCellLink(colPath(icolPath), "Daten", "A4")
avntData(icolPath + 1, 5) = getCellLink(colPath(icolPath), "Daten", "A5")
avntData(icolPath + 1, 6) = getCellLink(colPath(icolPath), "Daten", "A6")

Next

With Tabelle2
'.UsedRange.Clear
Range("A3:F100").ClearContents
With .Range("A2").Resize(UBound(avntData, 1), UBound(avntData, 2))
.Formula = avntData()
.Formula = .Value
End With
End With

Application.ScreenUpdating = True

End If

Set colPath = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn mir jemand beim Einbau dieser If Frage helfen könnte wäre super.
Gruß Karsten

Office: (Office 2013) Ordner durchsuchen und xlsx auflisten

Ordner durchsuchen und xlsx auflisten

Ordner durchsuchen und xlsx auflisten

Ordner durchsuchen und xlsx auflisten

Ordner durchsuchen und xlsx auflisten

Ordner durchsuchen und xlsx auflisten - Similar Threads - Ordner durchsuchen xlsx

Outlook - Ordner gesendete Elemente wechseln

Ordner durchsuchen , Dateien aussuchen und Dateien verschieben

Ordner rekursiv nach Dateien durchsuchen & Dateien öffnen

Ordner nach Dateien durchsuchen und als Tabellenblatt öffnen

Ordner durchsuchen und Hyperlink ertsellen

Ordner nach Dokument mit gewissen Änderungsdatum durchsuchen

Persönliche UND Öffentliche Ordner durchsuchen