option explicit
dim dateiliste(10000) 'Liste der gefundenen zutreffenden Dateinamen
dim fs ' FileSystemObject-Referenz
dim frage ' Fragen an den User
dim ordner ' Dateiordner mit den Dateien
dim ext ' Extension (also Dateityp), der gesucht werden soll
dim extersatz ' Ersatz für Extension
dim counter ' Anzahl gefundener Dateien des gewünschten Dateityps
dim ordnerhandle ' Handle auf den Ordner, der die Dateien enthält
dim ordnername ' genauer Pfadname des Ordners
dim datei ' Handle der Dateien im Ordner
dim dateiname ' Dateiname der untersuchten Datei, ohne Pfad und Extension
dim extension ' Extension der untersuchten Datei (Dateityp)
dim antwort ' Antwort auf Abfragen
dim target ' Name der konvertierten Datei mit Pfad
dim WSHShell
counter=0
'Zugriff auf ActiveX-Objekte des Systems herstellen
set fs = CreateObject("Scripting.FileSystemObject")
set WSHShell = CreateObject("WScript.Shell")
' Angaben zur Konversion erfragen
frage = "Welcher Ordner soll bearbeitet werden?"
ordner = IB(frage, "Quell-Ordner", "")
' Existiert der angegebene Ordner überhaupt?
if not fs.FolderExists(ordner) then
MsgBox "Der Ordner " & ordner & " existiert nicht! Abbruch!", vbExclamation
WScript.Quit
end if
frage = "Wie heißt die Dateiextension des Dateityps, den Sie ändern wollen?"
ext = replace(lcase(IB(frage, "Extension", "m4a")), ".", "")
frage = "Wie heißt die neue Dateiextension?"
extersatz = replace(lcase(IB(frage, "Extension", "m4r")), ".", "")
' Ordner mit den Dateien öffnen
set ordnerhandle = fs.GetFolder(ordner)
ordnername = ordnerhandle.path
' Jede Datei im Ordner untersuchen
for each datei in ordnerhandle.files
dateiname = fs.GetBaseName(datei.Name)
extension = lcase(fs.GetExtensionName(datei.Name))
' Richtiger Dateityp?
if extension = ext then
target = ordner + "\" + dateiname + "." + extersatz
counter = counter + 1
dateiliste(counter) = datei.path
set datei = fs.GetFile(dateiliste(counter))
fs.CopyFile datei, target
end if
next
'Ergebnis präsentieren
if counter = 0 then
frage = "Keine Dateien zu konvertieren." + vbCr + "Das Programm bricht ab!"
MsgBox frage, vbInformation
else
frage = counter & " Datei(en) umbenannt." + vbCr + "Erledigt!"
MsgBox frage, vbInformation
end if
WScript.Quit
function IB(a, b, c)
IB = InputBox(a, b, c)
if IB="" then
MsgBox "Abbruch!", vbInformation
WScript.Quit
end if
end function
