'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