http://dieseyer.de • all rights reserved • © 2011 v11.4

'v5.1*****************************************************
' File: DateiErweiterung-1Zeichen.vbs
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Ändert von allen Dateien in einem Verzeichnis die
' Dateierweiterung auf 1 Zeichen ( tst.txt ==> tst.t )
'*********************************************************

Option Explicit

Dim WSHShell, fso
Dim oFolders, oSubFolder, oFiles, Folder
Dim i, Text, Pfad, ZielDatei, Datei(), DateiX

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

Pfad = "." ' Verzeichnis, in dem sich das Skript befindet
Pfad = "c:\test\zw"

if not fso.FolderExists( Pfad ) then
MsgBox UCase(Pfad) & " existiert nicht!" & vbCRLF & vbCRLF & " . . . das ist das Ende.", , WScript.ScriptName
WScript.Quit
End If



' Dateiliste
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set oFolders = fso.GetFolder( Pfad )
Set oFiles = oFolders.Files
For Each DateiX In oFiles
ReDim Preserve Datei(i)
Datei(i) = DateiX.Name
i = i + 1
Next
Set oFiles = nothing
Set oFolders = nothing



' Dateien umbenennen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For i = LBound(Datei) to UBound(Datei)
if Fso FileExists( Datei(i) ) Then
ZielDatei = Pfad & "\" & fso.GetBaseName( Datei(i) ) & "." & Left( fso.GetExtensionName( Datei(i) ), 1)

if UCase( Pfad & "\" & Datei(i) ) = UCase( ZielDatei ) then
Text = Text & Pfad & "\" & Datei(i) & vbTab & " unverändert?!" & vbCRLF
Else

if fso.FileExists ( ZielDatei ) then
if vbYes = MsgBox (" Zieldatei" & vbCRLF & UCase( ZielDatei ) & vbCRLF & "existiert bereits und wird gelöscht!" , 4 , WScript.ScriptName ) then

fso.DeleteFile ZielDatei, True
fso.MoveFile Pfad & "\" & Datei(i) , ZielDatei
Text = Text & Pfad & "\" & Datei(i) & vbTab & " doppel ==> ! " & ZielDatei & vbCRLF
End If
Text = Text & Pfad & "\" & Datei(i) & vbTab & " Zieldatei nicht überschrieben! " & vbCRLF
Else
fso.MoveFile Pfad & "\" & Datei(i) , ZielDatei
Text = Text & Pfad & "\" & Datei(i) & " ==> " & ZielDatei & vbCRLF
End If
End If
End If
Next



' Was angerichtet wurde wird angezeigt:
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
MsgBox "In " & UCase(Pfad) & " wurden folgende Dateien umbenannt:" & vbCRLF & vbCRLF & Text, , WScript.Scriptname
Text = ""

WScript.Quit


http://dieseyer.de • all rights reserved • © 2011 v11.4