5
Einkürzen aller Dateien in einem Verzeichnis auf länge X
Hallo,
ich möchte gerne in einem Verzeichnis X alle Dateien mit der Endung TXT auf eine maximale Länge von 50 Zeichen einkürzen
Wie kann ich das am besten per VBA umsetzen?
Grüße aus München
ich möchte gerne in einem Verzeichnis X alle Dateien mit der Endung TXT auf eine maximale Länge von 50 Zeichen einkürzen
Wie kann ich das am besten per VBA umsetzen?
Grüße aus München
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 269084
Url: https://administrator.de/contentid/269084
Printed on: April 25, 2024 at 00:04 o'clock
5 Comments
Latest comment
Hallo Thomas,
z.B. so
(ich gehe hier davon aus das du die 50 Zeichen inkl. Dateierweiterung meinst)
Grüße Uwe
z.B. so
(ich gehe hier davon aus das du die 50 Zeichen inkl. Dateierweiterung meinst)
On Error Resume Next
Const FOLDER = "C:\Ordner"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each file In fso.GetFolder(FOLDER).Files
If LCase(fso.GetExtensionName(file.Name)) = "txt" And Len(file.Name) > 50 Then
newname = file.ParentFolder & "\" & (Left(file.Name,46) & ".txt")
file.Move newname
If Err.Number > 0 Then
MsgBox Err.Description & vbNewLine & newname,vbCritical
End If
End If
Next
Hallo Uwe,
danke für die Information,
klappt wunderbar.
Besteht die Möglichkeit dieses Script noch zu erweitern und zwar soll er die Dateien löschen, wenn im Dateinamen gewisse Wörter vorkommen..
Sprich vor dem Prüfen auf länge, Prüfe ob Wort X in Datei vorhanden dann löschen ansonste fahre mit dem einkürzen fort.
Gruß
Thomas
danke für die Information,
klappt wunderbar.
Besteht die Möglichkeit dieses Script noch zu erweitern und zwar soll er die Dateien löschen, wenn im Dateinamen gewisse Wörter vorkommen..
Sprich vor dem Prüfen auf länge, Prüfe ob Wort X in Datei vorhanden dann löschen ansonste fahre mit dem einkürzen fort.
Gruß
Thomas
Ich glaube eher es ist der Text im inneren der Datei gemeint?
Also die Textdatei im VBA einlesen und den Inhalt in eine Variable übernehmen. Dann:
Langertext = "Variable mit mehr als X Zeichen"
kurzertext = Left(test, 50)
Das Ergebnis dann zurück in die Datei schreiben.
LG,
Thomas
EDIT:
Okay - da hat thomas1972 geantwortet bevor ich auf Senden geklickt habe.
Hat sich scheinbar doch auf die Dateinamen bezogen.
Also die Textdatei im VBA einlesen und den Inhalt in eine Variable übernehmen. Dann:
Langertext = "Variable mit mehr als X Zeichen"
kurzertext = Left(test, 50)
Das Ergebnis dann zurück in die Datei schreiben.
LG,
Thomas
EDIT:
Okay - da hat thomas1972 geantwortet bevor ich auf Senden geklickt habe.
Hat sich scheinbar doch auf die Dateinamen bezogen.
Zitat von @thomas1972:
Besteht die Möglichkeit dieses Script noch zu erweitern und zwar soll er die Dateien löschen, wenn im Dateinamen gewisse
Wörter vorkommen..
Sprich vor dem Prüfen auf länge, Prüfe ob Wort X in Datei vorhanden dann löschen ansonste fahre mit dem
einkürzen fort.
Lässt sich machen...in Zeile 3 die Keywords ins Array eintragenBesteht die Möglichkeit dieses Script noch zu erweitern und zwar soll er die Dateien löschen, wenn im Dateinamen gewisse
Wörter vorkommen..
Sprich vor dem Prüfen auf länge, Prüfe ob Wort X in Datei vorhanden dann löschen ansonste fahre mit dem
einkürzen fort.
On Error Resume Next
Const FOLDER = "C:\ordner"
keywords = Array("Wort1","Wort2")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each file In fso.GetFolder(FOLDER).Files
If LCase(fso.GetExtensionName(file.Name)) = "txt" Then
deleted = False
For i = 0 To UBound(keywords)
If InStr(1,file.Name,keywords(i),1) > 0 Then
file.Delete
deleted = True
Exit For
End If
Next
If Not deleted Then
If Len(file.Name) > 50 Then
newname = file.ParentFolder & "\" & (Left(file.Name,46) & ".txt")
file.Move newname
If Err.Number > 0 Then
MsgBox Err.Description & vbNewLine & newname,vbCritical
End If
End If
End If
End If
NextEin Weitere Möglichkeit ist Regular Expressions für die Keywords zu nutzen / Zeile 6 ist der RegEx Pattern (damit hat man dann mehr Möglichkeiten der Keywordgestaltung. Bitte beachte aber das es sich um einen "Regular Expression Pattern" handelt in dem Sonderzeichen besondere Bedeutung haben!):
On Error Resume Next
Const FOLDER = "C:\ordner"
Set fso = CreateObject("Scripting.FileSystemObject")
Set regex = CreateObject("vbscript.regexp")
regex.IgnoreCase = True
regex.Pattern = "Wort1|Wort2|Wort3"
For Each file In fso.GetFolder(FOLDER).Files
If LCase(fso.GetExtensionName(file.Name)) = "txt" Then
If regex.Test(file.Name) Then
file.Delete
Else
If Len(file.Name) > 50 Then
newname = file.ParentFolder & "\" & (Left(file.Name,46) & ".txt")
file.Move newname
If Err.Number > 0 Then
MsgBox Err.Description & vbNewLine & newname,vbCritical
End If
End If
End If
End If
Next
1
Danke Uwe, für die scnhelle und unkomplizierte Hilfe..
