VBScript doppelter Dateiname

Hi ich habe versucht die doppelten BaseDateinamen zu Filtern.
Am Ende sollte ein Ordner erstellt werden wenn ein BaseNamen von einer Datei 2 mal vorhanden ist.
zum Beispiel:
abc.txt
abc 01.txt
-> Ordner abc erstellen
xyz
-> keine Aktion

Set FSO=CreateObject("Scripting.FileSystemObject")  
For Each DATEI01 In FSO.GetFolder("C:\New").Files  
DATEINAME=Left(DATEI01.Name,Len(DATEI01.Name)-4)
For Each DATEI02 In FSO.GetFolder("C:\New").Files  
If Instr(DATEI02.Name,DATEINAME)>0 Then
AUSGABE=AUSGABE & DATEI02.Name & VbCrLf
End If
Next
Next
MsgBox AUSGABE

In dem Script wird der doppelte Dateiname jeh nach Häufigkeit so oft angezeigt wie er im BaseName vorkommt.
Wie kann ich herausfinden ob der BaseName doppelt existiert oder mehrmals und wenn ja den BaseName-Ordner erstellen? Muss ich die Strings aus der AUSGABE Collektion miteinander vergleichen?

Gruß waldgnarf

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 94728

Url: https://administrator.de/contentid/94728

Ausgedruckt am: 20.11.2024 um 11:11 Uhr

6 Kommentare

Neuester Kommentar

Hallo waldgnarf!

Einige Überlegungen zu Deinem Konzept:

Zunächst könnte das nur funktionieren (und auch dann nicht mit dieser Version des Scripts), wenn die Dateien in der "Files"-Auflistung sortiert wären (und daher die jeweils kürzeren Dateinamen zuerst kämen) - Du erhältst sie aber in der selben Reihenfolge wie mit einem "dir" ohne Parameter unter CMD.

Mit InStr() stellst Du nur fest, ob ein String in einem anderen enthalten ist - daher würde "xyz abc.txt" ebenfalls gefunden werden (könnte aber natürlich auch Deine Absicht sein).

Nicht gefunden würde allerdings "Abc" oder "ABC", da Stringvergleiche in VB(S) case-sensitive sind (solange Du nicht explizit mit "vbTextCompare" das Gegenteil festlegst).

Da die erste Schleife ja alle Dateien des angegebenen Ordners erfasst, würdest Du mit der aktuellen Fassung einen Ordner "abc" erhalten, aber zB zusätzlich auch noch einen Ordner "abc 01", wenn es etwa noch eine Datei "abc 01.bak" oder "abc 01-alt.txt" gäbe ...

----
Vielleicht stellst Du kurz dar, wie in etwa der Inhalt des Ordners "C:\New" aussieht, und was genau das angestrebte Ziel ist ...

Grüße
bastla

Hi, verschiedene Dateien befinden sich im Ordner /New.
Alle haben einen anderen Namen und oft auch unterschiedliche Endungen. Ich habe versucht mit dem Script zu erreichen das wenn ein Dateiname doppelt vorkommt, ungeachtet von den Endungen oder Zahlenanhänge wie 01, ein Ordner mit dem doppelt vorkommenden Namen erstellt wird und die Dateien in den Ordner verschoben werden.

Gruß waldgnarf

Hallo waldgnarf!

Das Prinzip hatte ich schon verstanden, aber der Teufel steckt ja bekanntlich im Detail - hier zB in der Frage, woran ein "Dateiname" zu erkennen ist, ob es für die Namen ein Schema gibt, etwa:
Alles bis zum ersten Leerzeichen (oder, falls keines enthalten, der gesamte Dateiname) gilt als "Name."
oder:
Der "Name" entspricht den ersten 5 Zeichen des Dateinamens.
etc ...

Wenn ich nochmals das Beispiel von oben strapaziere (und noch etwas ausdehne):
Inhalt von "C:\New" soll ua sein:

abc 01.txt
abc 01.log
abc.txt
abc 01.bak
abcde.txt
abc 01-alt.txt
abcde_080808.log
xyz_abc 01.txt
a 01.txt
ab#cd.log
xyzabc.txt
abcd-alt.txt
ab.doc
xyz abc.txt
abc_test.txt
ab-01.txt
abcd efgh.log
a.txt

Wie sähe dafür das gewünschte Ergebnis aus?

Grüße
bastla

Guten Abend, sorry also bis zum Leerzeichen währe das was ich suche. Oder alle Nummern und Leerzeichen aus dem Dateinamen-String enfernen.

Hallo Waldgnarf!

Versuch es damit:

StartOrdner = "C:\New"  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set d = CreateObject("Scripting.Dictionary") 'Dictionary zum Sammeln der verschiedenen Dateinamen(sbestandteile) und Festhalten der Häufigkeiten  
d.CompareMode = vbTextCompare 'Groß-/Kleinschreibung nicht beachten  

For Each Datei In fso.GetFolder(StartOrdner).Files
    Key = Split(fso.GetBaseName(Datei.Name), " ")(0) 'Dateinamensbestandteil bis zum ersten Leerzeichen ermitteln  
    If d.Exists(Key) Then 'Dateiname mehrfach vorhanden  
        d.Item(Key) = d.Item(Key) + 1 'Zähler erhöhen  
    Else 'Dateiname kommt erstmals vor  
        d.Add Key, 1
    End If
Next

For Each Key In d.Keys
    If d.Item(Key) > 1 Then 'mehrere Dateinamen, daher in Ordner verschieben  
        Ordner = StartOrdner & "\" & Key  
        If Not fso.FileExists(Ordner) Then 'keine gleichnamige Datei vorhanden, Ordner kann bei Bedarf erstellt werden  
            If Not fso.FolderExists(Ordner) Then fso.CreateFolder(Ordner) 'Ordner erstellen  
            fso.MoveFile StartOrdner & "\" & Key & ".*", Ordner 'alle Dateien ohne Nummer verschieben  
            fso.MoveFile StartOrdner & "\" & Key & " *.*", Ordner 'alle Dateien mit Nummer verschieben  
        Else
            WScript.Echo "Ordner " & Ordner & " kann nicht erstellt werden."  
        End If
    End If
Next
Set d = Nothing