Hallo an alle!
Ich habe bereits ein funktionierendes Makro von einem Kollegen bekommen.
Man klickt auf einen Button und wählt den entsprechenden Ordner an, dann listet er alle Unterordner und Datein in die Zeilen darunter auf.
Nur gibt es jetzt folgendes Problem:
Der Kunde will, dass alle Datein mit einem "=" (!) beginnen. (Ja ich weiß, Dateiname & Sonderzeichen und dann auch noch am Anfang...)
Natürlich kommt dann immer die Fehlermeldung bzw. gelb hinterlegte Zeile
.Value = f.Name
Ich hab jetzt schon zwei Lösungsansätze von hier aus dem Forum versucht, aber leider beides ohne Erfolg.
Gibts da eine Lösung?
Eine Lösung AUSSERHALB von VBA wäre ja die komplette Doku Kopieren und mit einem anderen Tool alle "=" entfernen
Es sind aber sehr viele Datein mit einigen GB
Danke schon mal Vorab für eure Hilfe
Hier der Code vom aktuellen Makro (ich hoffe das geht)
Option Explicit
Public Sub OrdnerListen_Start()
Dim fso As Object
Dim strPfad As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Start-Verzeichnis wählen"
.ButtonName = "übernehmen"
If .Show <> -1 Then Exit Sub
strPfad = .SelectedItems(1)
End With
With ActiveSheet
.UsedRange.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Call OrdnerListen(fso, strPfad, .Range("A1")) ' Pfad anpassen!
Set fso = Nothing
End With
End Sub
Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)
Dim o, uo, f
Set o = fso.GetFolder(Ordnerangabe)
With rng.Offset(Zeile, Spalte)
.Value = o.Name
.Font.Bold = True
End With
Zeile = Zeile + 1
For Each f In o.Files
With rng.Offset(Zeile, 1)
.Value = f.Name
' .IndentLevel = 1
End With
Zeile = Zeile + 1
Next
Set f = Nothing
For Each uo In o.SubFolders
Spalte = Spalte
Call OrdnerListen(fso, uo.Path, rng, Zeile, Spalte)
Spalte = Spalte
Next
Set o = Nothing
Set uo = Nothing
End Sub