Das Sortieren von Dateien automatisieren

[Cherubim]

Guten Morgen,

ich habe hier auf der Arbeit gerade festgestellt, das der Eingangsordner (Vertrieb) von Kundenteilen und Dateien von Externen eine mittlere Katastrophe ist.
Ich habe jetzt aber keine Lust, manuell Jahre an "einfach reingeworfen" zu sortieren.

Gibt es eine Möglichkeit, automatisiert und eventuell über Unterordner (Neuer Ordner oder Herr XYZ oder einfach ein Datum) Dateien an ihrem Dateinamen in Ordner zu sortieren?
Das einzige was geklappt hat ist, dass alle Dateien mit dem Namen der Firma bzw der Person beginnen, dann ein -
Zb: Firma ABC - Datensatz Maschine 1 22.10.18.zip

Ich suche also etwas, dass jetzt darüber läuft und erkennt "Firma ABC", dann, wenn noch nicht vorhanden, einen Ordner "Firma ABC" erstellt und die Datei und alle anderen der Firma ABC da rein verschiebt.

[cessy000]

lässt sich relative einfach über VBA realisieren...Irgendeine Erfahrung damit ?

Deinen text kannst du genauso übrigens bei CHATGPT eingeben und du bekommst ein funktionierendes Programm das du noch anpassen kannst.
Wenn du nach VBA programm fragst.
Hab es gerade eben ausprobiert:

Beispiel:

Sub SortiereDateien()
Dim Eingangsordner As String
Dim Zielordner As String
Dim Dateiname As String
Dim Firmenname As String
Dim Firmenordner As String

' Definiere den Pfad zum Eingangsordner
Eingangsordner = "Pfad\zum\Eingangsordner"

' Überprüfe, ob der Eingangsordner existiert
If Dir(Eingangsordner, vbDirectory) = "" Then
MsgBox "Der angegebene Eingangsordner existiert nicht.", vbExclamation
Exit Sub
End If

' Durchlaufe alle Dateien im Eingangsordner
Dateiname = Dir(Eingangsordner & "*.*")
Do While Dateiname <> ""
' Überprüfe, ob es sich um eine Datei handelt (kein Ordner)
If Not (GetAttr(Eingangsordner & Dateiname) And vbDirectory) = vbDirectory Then
' Extrahiere den Firmennamen aus dem Dateinamen
Firmenname = ExtrahiereFirmenname(Dateiname)
' Wenn ein Firmenname gefunden wurde
If Firmenname <> "" Then
' Erstelle den Zielordner für die Firma, falls er nicht existiert
Zielordner = Eingangsordner & Firmenname & ""
If Dir(Zielordner, vbDirectory) = "" Then
MkDir Zielordner
End If
' Verschiebe die Datei in den Zielordner
FileCopy Eingangsordner & Dateiname, Zielordner & Dateiname
Kill Eingangsordner & Dateiname
End If
End If
' Gehe zur nächsten Datei
Dateiname = Dir
Loop

MsgBox "Die Dateien wurden erfolgreich sortiert.", vbInformation
End Sub

Function ExtrahiereFirmenname(Dateiname As String) As String
Dim Teile() As String
' Teile den Dateinamen anhand des Trennzeichens "-" auf
Teile = Split(Dateiname, "-")
' Extrahiere den Firmennamen aus dem ersten Teil des Dateinamens
If UBound(Teile) > 0 Then
ExtrahiereFirmenname = Trim(Teile(0))
Else
ExtrahiereFirmenname = ""
End If
End Function