Live-Forum - Die aktuellen Beiträge
Datum
Titel
03.11.2025 15:51:02
Zelle E1,Uhrzeit ,gleiche Datum in sichtbare Zellen N suchen
03.11.2025 14:48:20
Links funktionieren nur bei ganzer Tabelle, nicht bei Auszug
03.11.2025 12:49:44
Zählenwenn verwenden über VBA mit einem ExcelNamen
03.11.2025 09:55:38
VBA: Notiz zu einer Zelle hinzufügen funktioniert nicht
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1800to1804
1800to1804
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Mehrere Verzeichnisse einlesen?

Forumthread: Mehrere Verzeichnisse einlesen?

Mehrere Verzeichnisse einlesen?
26.12.2020 17:30:57
Sergej
Hallo Leute,
mit diesem Code lese ich alle CFG-Dateien eines Ordners ein. Soweit alles in Ordnung.
Sub CFG_Files_List()
Dim strOrdner As String, strDatei As String
Dim lngZ As Long
lngZ = 3
Range("A3:D" & Range("A65536").End(xlUp).Row).ClearContents
strOrdner = "M:\Vorlagen\BA-SAR01\Einstellungen\projects\"
strDatei = Dir(strOrdner & "*.cfg")
If strDatei  "" Then
Cells(lngZ, 1) = strOrdner & strDatei               'Pfad
Cells(lngZ, 2) = FileLen(strOrdner & strDatei)      'Größe
Cells(lngZ, 3) = FileDateTime(strOrdner & strDatei) 'Datum/Zeit
Cells(lngZ, 4) = strDatei                           'nur Dateiname
lngZ = lngZ + 1
Do While strDatei  ""
strDatei = Dir
If strDatei  "" Then
Cells(lngZ, 1) = strOrdner & strDatei
Cells(lngZ, 1).Hyperlinks.Add Anchor:=Cells(lngZ - 1, 1), Address:=Cells(lngZ - 1,  _
1), ScreenTip:=Cells(lngZ, 1).Text, TextToDisplay:=Cells(lngZ - 1, 1).Text
Cells(lngZ, 2) = FileLen(strOrdner & strDatei)
Cells(lngZ, 3) = FileDateTime(strOrdner & strDatei)
Cells(lngZ, 4) = strDatei
Cells(lngZ, 4).Hyperlinks.Add Anchor:=Cells(lngZ - 1, 4), Address:=Cells(lngZ - 1,  _
1), ScreenTip:=Cells(lngZ - 1, 4).Text, TextToDisplay:=Cells(lngZ - 1, 4).Text
lngZ = lngZ + 1
End If
Loop
End If
End Sub

Was muss ich bitte im Code erweitern, wenn 15 weitere Pfade bei der Auflistung berücksichtigt werden sollen?
Beste Grüße,
Sergej
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Verzeichnisse einlesen?
26.12.2020 18:13:02
Nepumuk
Hallo Sergej,
teste mal:
Option Explicit

Sub CFG_Files_List()
    Dim avntFolders As Variant, vntFolder As Variant
    Dim strDatei As String
    Dim lngZ As Long
    lngZ = 3
    Range("A3:D" & Range("A65536").End(xlUp).Row).ClearContents
    
    avntFolders = Array("M:\Vorlagen\BA-SAR01\Einstellungen\projects\", _
        "M:\Vorlagen\BA-SAR02\Einstellungen\projects\", _
        "M:\Vorlagen\BA-SAR03\Einstellungen\projects\", _
        "M:\Vorlagen\BA-SAR04\Einstellungen\projects\") 'Hier alle Ordner eintragen !!!
    
    For Each vntFolder In avntFolders
        
        strDatei = Dir(vntFolder & "*.cfg")
        
        If strDatei <> "" Then
            
            Cells(lngZ, 1) = vntFolder & strDatei 'Pfad
            Cells(lngZ, 2) = FileLen(vntFolder & strDatei) 'Größe
            Cells(lngZ, 3) = FileDateTime(vntFolder & strDatei) 'Datum/Zeit
            Cells(lngZ, 4) = strDatei 'nur Dateiname
            lngZ = lngZ + 1
            Do Until strDatei = ""
                strDatei = Dir
                If strDatei <> "" Then
                    Cells(lngZ, 1) = vntFolder & strDatei
                    Cells(lngZ, 1).Hyperlinks.Add Anchor:=Cells(lngZ - 1, 1), Address:=Cells(lngZ - 1, _
                        1), ScreenTip:=Cells(lngZ, 1).Text, TextToDisplay:=Cells(lngZ - 1, 1).Text
                    Cells(lngZ, 2) = FileLen(vntFolder & strDatei)
                    Cells(lngZ, 3) = FileDateTime(vntFolder & strDatei)
                    Cells(lngZ, 4) = strDatei
                    Cells(lngZ, 4).Hyperlinks.Add Anchor:=Cells(lngZ - 1, 4), Address:=Cells(lngZ - 1, _
                        1), ScreenTip:=Cells(lngZ - 1, 4).Text, TextToDisplay:=Cells(lngZ - 1, 4).Text
                    lngZ = lngZ + 1
                End If
            Loop
        End If
    Next
End Sub

Gruß
Nepumuk
Anzeige
AW: Mehrere Verzeichnisse einlesen?
26.12.2020 18:45:26
Sergej
Hallo lieber Nepumuk,
wie immer perfekt. Vielen herzlichen Dank!
Ich habe noch eine Frage, die sehr wahrscheinlich nicht einfach zu lösen ist, um dieses Makro zu erweitern. In Spalte 5, 6 und 7 möchte ich gerne noch bestimmte Inhalte aus der CFG-Datei einlesen.
Es soll in der CFG-Datei nach Wörter gesucht werden, die in der Zeile mit KUNDE_PRJ, LOGO_PATH oder LX_DIR beginnen und nach dem Suchwort ein = (steht immer nur leider mal mit Leerzeichen und mal ohne Leerzeichen) steht. Die Inhalte nach dem Zeichen = sollen ausgelesen werden.
Ausschnitt der CFG-Datei:
...
...
KUNDE_PRJ = Sanofi
...
LOGO_PATH= P:\Logos\Sanofi.jpg
...
LX_DIR=S:\Sola\CD-05800\Sanofi\
...
...
Ergebnisse:
Spalte E = Sanofi
Spalte F = P:\Logos\Sanofi.jpg
Spalte G = S:\Sola\CD-05800\Sanofi\
Kannst du mir hierbei bitte helfen?
Beste Grüße,
Sergej
Anzeige
AW: Mehrere Verzeichnisse einlesen?
26.12.2020 19:15:23
Nepumuk
Hallo Sergej,
so ganz kann ich deiner Logik beim einfügen der Daten nicht folgen. Z.B. warum erzeugst du die Hyperlinks erst bei der 2. Datei?
Teste mal:
Option Explicit

Public Sub CFG_Files_List()
    Dim avntFolders As Variant, vntFolder As Variant
    Dim strDatei As String, strText As String
    Dim lngZ As Long, lngCounter As Long
    Dim intFileNumber As Integer
    
    Reset
    intFileNumber = FreeFile
    
    lngZ = 3
    Range("A3:D" & Range("A65536").End(xlUp).Row).ClearContents
    
    avntFolders = Array("M:\Vorlagen\BA-SAR01\Einstellungen\projects\", _
        "M:\Vorlagen\BA-SAR02\Einstellungen\projects\", _
        "M:\Vorlagen\BA-SAR03\Einstellungen\projects\", _
        "M:\Vorlagen\BA-SAR04\Einstellungen\projects\") 'Hier alle Ordner eintragen !!!
    
    For Each vntFolder In avntFolders
        
        strDatei = Dir(vntFolder & "*.cfg")
        
        If strDatei <> "" Then
            
            Cells(lngZ, 1) = vntFolder & strDatei 'Pfad
            Cells(lngZ, 2) = FileLen(vntFolder & strDatei) 'Größe
            Cells(lngZ, 3) = FileDateTime(vntFolder & strDatei) 'Datum/Zeit
            Cells(lngZ, 4) = strDatei 'nur Dateiname
            lngZ = lngZ + 1
            Do Until strDatei = ""
                strDatei = Dir
                If strDatei <> "" Then
                    Cells(lngZ, 1) = vntFolder & strDatei
                    Cells(lngZ, 1).Hyperlinks.Add Anchor:=Cells(lngZ - 1, 1), Address:=Cells(lngZ - 1, _
                        1), ScreenTip:=Cells(lngZ, 1).Text, TextToDisplay:=Cells(lngZ - 1, 1).Text
                    Cells(lngZ, 2) = FileLen(vntFolder & strDatei)
                    Cells(lngZ, 3) = FileDateTime(vntFolder & strDatei)
                    Cells(lngZ, 4) = strDatei
                    Cells(lngZ, 4).Hyperlinks.Add Anchor:=Cells(lngZ - 1, 4), Address:=Cells(lngZ - 1, _
                        1), ScreenTip:=Cells(lngZ - 1, 4).Text, TextToDisplay:=Cells(lngZ - 1, 4).Text
                    
                    lngCounter = 0
                    Open vntFolder & strDatei For Input As #intFileNumber
                    Do Until EOF(intFileNumber)
                        Line Input #intFileNumber, strText
                        If InStr(1, strText, "KUNDE_PRJ", vbTextCompare) > 0 Then
                            Cells(lngZ, 5).Value = Trim$(Split(strText, "=")(1))
                            lngCounter = lngCounter + 1
                        ElseIf InStr(1, strText, "LOGO_PATH", vbTextCompare) > 0 Then
                            Cells(lngZ, 6).Value = Trim$(Split(strText, "=")(1))
                            lngCounter = lngCounter + 1
                        ElseIf InStr(1, strText, "LX_DIR", vbTextCompare) > 0 Then
                            Cells(lngZ, 7).Value = Trim$(Split(strText, "=")(1))
                            lngCounter = lngCounter + 1
                        End If
                        If lngCounter = 3 Then Exit Do
                    Loop
                    Close #intFileNumber
                    
                    lngZ = lngZ + 1
                End If
            Loop
        End If
    Next
End Sub

Gruß
Nepumuk
Anzeige
AW: Mehrere Verzeichnisse einlesen?
26.12.2020 20:06:45
Sergej
Hallo Nepumuk,
du hast recht. Das war mein Fehler ;-) Ich habe lngZ = lngZ + 1 entfernt und im Verlauf des Codes lngZ - 1 in lngZ geändert.
Ich habe deine Erweiterung detailliert getestet.
1. Die CFG-Dateien mit Leerzeichen in Dateinamen werden nicht importiert.
2. Ich habe noch eine Spalte analog wie in deinem Beispiel, mit dem Suchbegriff KUNDE_PRJ_NAME erweitert:
                        ElseIf InStr(1, strText, "KUNDE_PRJ_NAME", vbTextCompare) > 0 Then
Cells(lngZ, 8).Value = Trim$(Split(strText, "=")(1))
lngCounter = lngCounter + 1
End If
If lngCounter = 4 Then Exit Do
Kann es bitte sein, dann nicht exakt nach Wort gesucht wird, der in der Zeile haargenau beginnt, wie im Code vorgegeben ist? Jetzt wird mein erweitertes Suchbegriff in Spalte 5 anstatt in Spalte 8 importiert. ;-)
Beste Grüße,
Sergej
Anzeige
AW: Mehrere Verzeichnisse einlesen?
26.12.2020 20:17:22
Nepumuk
Hallo Sergej,
1. Das Dateien mit Leerzeichen im Namen nicht geöffnet werden, kann ich mir nicht vorstellen.
2. Es wird nach genauer Übereinstimmung gesucht, wobei Groß- Kleinschreibung nicht berücksichtigt wird. Von hier aus kann ich das nicht prüfen. Kannst du mal so eine Datei gezippt hochladen?
Gruß
Nepumuk
Anzeige
AW: Mehrere Verzeichnisse einlesen?
26.12.2020 21:57:54
Sergej
Hallo Nepumuk,
ich habe nochmals getestet. Irgendwo habe ich Wurm im Code mit lngZ = lngZ + 1 ;-)
Die Hyperlinks und das Einlesen der Daten aus CFG-Dateien soll natürlich ab erste Datei erfolgen.
Das Problem mit Dateien mit Leerzeichen in Namen, lag doch an der auskommentierter Zeile lngZ = lngZ + 1.
Anbei eine CFG-Datei in gezippter Form: https://www.herber.de/bbs/user/142563.zip
Beste Grüße,
Sergej
Anzeige
AW: Mehrere Verzeichnisse einlesen?
27.12.2020 12:02:16
Nepumuk
Hallo Sergej,
teste mal:
Option Explicit

Public Sub CFG_Files_List()
Dim avntFolders As Variant, vntFolder As Variant
Dim strFileName As String, strText As String
Dim lngRow As Long
Dim intFileNumber As Integer

Application.ScreenUpdating = False

Reset
intFileNumber = FreeFile

lngRow = 3

Call Range("A3:D" & CStr(Rows.Count)).ClearContents

avntFolders = Array("M:\Vorlagen\BA-SAR01\Einstellungen\projects\", _
    "M:\Vorlagen\BA-SAR02\Einstellungen\projects\", _
    "M:\Vorlagen\BA-SAR03\Einstellungen\projects\", _
    "M:\Vorlagen\BA-SAR04\Einstellungen\projects\") 'Hier alle Ordner eintragen !!!

For Each vntFolder In avntFolders

strFileName = Dir$(vntFolder & "*.cfg")

Do Until strFileName = vbNullString

Call ActiveSheet.Hyperlinks.Add(Anchor:=Cells(lngRow, 1), Address:=Cells(lngRow - 1, 1), _
    ScreenTip:=vntFolder & strFileName, TextToDisplay:=vntFolder & strFileName) 'Pfad
Cells(lngRow, 2) = FileLen(vntFolder & strFileName) 'Größe
Cells(lngRow, 3) = FileDateTime(vntFolder & strFileName) 'Datum/Zeit
Call ActiveSheet.Hyperlinks.Add(Anchor:=Cells(lngRow, 4), Address:=vntFolder & strFileName, _
    ScreenTip:=strFileName, TextToDisplay:=strFileName) 'nur Dateiname

Open vntFolder & strFileName For Input As #intFileNumber

Do Until EOF(intFileNumber)
    
    Line Input #intFileNumber, strText
    
    If InStr(1, strText, "KUNDE_PRJ_NAME ", vbTextCompare) > 0 Or _
        InStr(1, strText, "KUNDE_PRJ_NAME=", vbTextCompare) > 0 Then
        If InStr(1, strText, "=", vbTextCompare) > 0 Then _
            Cells(lngRow, 8).Value = Trim$(Split(strText, "=")(1))
        ElseIf InStr(1, strText, "LX_DIR ", vbTextCompare) > 0 Or _
            InStr(1, strText, "LX_DIR=", vbTextCompare) > 0 Then
            If InStr(1, strText, "=", vbTextCompare) > 0 Then _
                Cells(lngRow, 7).Value = Trim$(Split(strText, "=")(1))
            ElseIf InStr(1, strText, "LOGO_PATH ", vbTextCompare) > 0 Or _
                InStr(1, strText, "LOGO_PATH=", vbTextCompare) > 0 Then
                If InStr(1, strText, "=", vbTextCompare) > 0 Then _
                    Cells(lngRow, 6).Value = Trim$(Split(strText, "=")(1))
                ElseIf InStr(1, strText, "KUNDE_PRJ ", vbTextCompare) > 0 Or _
                    InStr(1, strText, "KUNDE_PRJ=", vbTextCompare) > 0 Then
                    If InStr(1, strText, "=", vbTextCompare) > 0 Then _
                        Cells(lngRow, 5).Value = Trim$(Split(strText, "=")(1))
                End If
                
            Loop
            
            Close #intFileNumber
            
            lngRow = lngRow + 1
            
            strFileName = Dir$
            
        Loop
    Next
    
    Application.ScreenUpdating = True
    
End Sub

Gruß
Nepumuk
Anzeige
AW: Mehrere Verzeichnisse einlesen?
27.12.2020 12:37:16
Sergej
Hallo Nepumuk,
es sieht sehr gut aus. Vielen herzlichen Dank!
Zwei Fragen noch:
1. Die Spalte 5 soll als Text (NumberFormat = "@") formatiert werden. Wo trage ich es am besten ein?
2. Falls ich noch weitere Ergänzungen in Bezug auf Suchbegriffe habe, kann ich die Eintragungen einfach am Ende (wo andere Suchbegriffe sind) ergänzen, oder muss ich die Reihenfolge der Spalte beachten?
Beste Grüße,
Sergej
Anzeige
AW: Mehrere Verzeichnisse einlesen?
27.12.2020 12:48:13
Nepumuk
Hallo Sergej,
1. So:
lngRow = 3

Call Range("A3:H" & CStr(Rows.Count)).ClearContents
Columns(5).NumberFormat = "@"

avntFolders = Array("M:\Vorlagen\BA-SAR01\Einstellungen\projects\", _
    

2. Du musst nur aufpassen, dass wenn der Suchstring schon in einem anderen enthalten ist, der längere vor dem kürzeren kommt. Die Reihenfolge der Spalten spielt keine Rolle.
Gruß
Nepumuk
Anzeige
AW: Mehrere Verzeichnisse einlesen?
27.12.2020 13:00:08
Sergej
Hallo Nepumuk,
vielen herzlichen Dank!
Ich wünsche dir einen schönen Restsonntag.
Beste Grüße,
Sergej
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige