Mit VBScript Filenames ergänzen bzw ändern

[adminnaddel]

Hallo liebe Gemeinde,

ich arbeite viel mit LN und Html-Links, muß aber immer wieder feststellen, daß in der historisch gewachsenen Filestruktur der Kundenverzeichnisse viele Filenames getrennt durch Leerschritte sind 

Nun gibt es die Möglichkeit, das ich mir händisch die 5000 Dateien nehme und überprüfe oder ich bastel mir ein Script!

Jemand eine Ahnung, wie man das realisieren kann?

lg
andy

[adminnaddel]

Okay .. Ihr da draußen ....

vielleicht habe ich mich ja wieder einmal mißverständlich ausgedrückt 

Ich suche nach einer Möglichkeit, in einem Verzeichnis nach einem bestimmtem String (dem Leerschritt) im Dateinamen zu suchen! Wenn gefunden, ersetze diesen String durch z.B. einem " _ " !!!

lg
Andy

[sloe]

Hi,
Benutzung auf eigene Gefahr...

' *************************************
' C:\KillSpace.vbs
' Ersetze Leer-Zeichen in Dateinamen
' 18.01.05 09:58
' (C) by Sloe 2005
' *************************************


Option Explicit
Dim oFso, oFolder, oShell, objFile
Dim sPfad, NewFileName, MyFile
Dim SearchString, SearchChar, Pos, ReplaceWith
Call Main

Sub Main
   Set oFso = WScript.CreateObject("Scripting.FileSystemObject")
   Set oShell = WScript.CreateObject("WScript.Shell")
   sPfad = Inputbox("Bitte Ordnerpfad eingeben:" , , "E:\TestRename")
   SearchChar = " "   ' Search for " ".
   Set oFolder = oFso.GetFolder(sPfad)
   For Each objFile In oFolder.Files
      SearchString = objFile.Name ' String to search in.
      ReplaceWith = "_"
      Pos = Instr(1, SearchString, SearchChar)   ' Search...
      If Len(Pos) > 0 Then
         ' Hit, now replace
         NewFileName = Replace(SearchString, SearchChar, ReplaceWith)      
         Set MyFile = oFso.GetFile(sPfad & "\" & SearchString)
         MyFile.Move sPfad & "\" & NewFileName
      End If
   Next
   WScript.Echo "Auftrag ausgeführt!"
End Sub

[adminnaddel]

@sloe  ....


Vielen Dank für deinen Code! Habe es im Testverzeichnis getestet und es funktioniert!  danke!

Aber warum sagst du: "auf eigene Gefahr"?
Habe ich etwas zu befürchten?

lg
Andy

[adminnaddel]

Okay, für alle die ebenfalls auf das VBS Lust verspüren, ich habe den Code durch eine Verzeichnisauswahl ergänzt, um es konfartabler zu gestalten!

Option Explicit
Dim oFso, oFolder, oShell, objFile, objShell, objFolder, objFolderItem
Dim sPfad, NewFileName, MyFile, strNewName, objPath, intValue
Dim SearchString, SearchChar, Pos, ReplaceWith
Call FolderAuswahl

Sub FolderAuswahl
  Const WINDOW_HANDLE = 0
  Const NO_OPTIONS = 0
  Const OverWriteFiles = True
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "Ordner mit Bildern auswählen:", NO_OPTIONS, "C:\ d:\")
  Set objFolderItem = objFolder.Self
  sPfad = objFolderItem.Path
End Sub

Call Main

Sub Main
   Set oFso = WScript.CreateObject("Scripting.FileSystemObject")
   Set oShell = WScript.CreateObject("WScript.Shell")
   SearchChar = " "   ' Search for " ".
   Set oFolder = oFso.GetFolder(sPfad)
   For Each objFile In oFolder.Files
      SearchString = objFile.Name ' String to search in.
      ReplaceWith = "_"
      Pos = Instr(1, SearchString, SearchChar)   ' Search...
      If Len(Pos) > 0 Then
         ' Hit, now replace
         NewFileName = Replace(SearchString, SearchChar, ReplaceWith)     
         Set MyFile = oFso.GetFile(sPfad & "\" & SearchString)
         MyFile.Move sPfad & "\" & NewFileName
      End If
   Next
   WScript.Echo "Auftrag ausgeführt!"
End Sub

lg
Andy

[sloe]

Hi,

naja, ist die übliche "machs-mir-schnell-und-dreckig"-Lösung.
Keine Überprüfung, ob die Datei während des Ablaufes umbenannt, verschoben, gelöscht, etc. wurde.
Aber ansonsten läuft es   , ist halt eine „salvatorische Klausel".  

Gruß
Sloe

P.S.: nette Erweiterung.

[adminnaddel]

so ... nun haben wir ja schon ein schönes kleines Script, welches ganz toll funktioniert!

Aber  .. die Auswahl beschränkt sich leider nur auf den ausgewählten Ordner, doch leider nicht auf die Subfolder!

Wollen wir mal  gemeinsam dieses ergänzen? 

lg
Andy

[Thomas Schulte]

um an alle Dateien die keine Extension hatten eine Extension anzuhängen (dreimal darfst du raten woher die Dateien kamen),wobei ich da das Error Handling etwas verbogen habe damit das funktioniert.
Das war ein Agent der aus ein paar Declarations und Subroutinen bestand und ein wenig mit Rekursion rumgespielt hat:
Declaration:
Dim directorylist List As String
Dim startentryposition As Integer
Dim listofdoctypes List As String
Initialize:
Dim session As New NotesSession
   Dim wksp As New NotesUIWorkspace
   Dim folder As Variant
   Dim ok As Integer
   Dim count As Integer
   
   Dim Basedir As String
   Dim extension As String
   
   listofdoctypes("doc") = "doc"
   listofdoctypes("xls") = "xls"
   listofdoctypes("ppt") = "ppt"
   listofdoctypes("txt") = "txt"
   listofdoctypes("xlt") = "xlt"
   listofdoctypes("dot") = "dot"
   listofdoctypes("rtf") = "rtf"
   
   basedir = Inputbox("Basisverzeichnis eintragen","Verzeichnis suchen","c:\temp")
   extension = Inputbox("Erweiterung eintragen","File Extension","xls")
   
   Startentryposition = 0
   directorylist(Cstr(startentryposition)) = basedir
   Startentryposition = startentryposition + 1
   ok = Messagebox ("folgende Daten wurden eingegeben: Verzeichnis " & basedir & " Erweiterung " & extension, 33 , "Diese Daten werden verwendet")
   If ok = 1 Then
      ' at first find all the directories
      Call finddirectories(basedir)
      ' for second get all the files in the previous found directories and rename them
      For Count = 0 To startentryposition-1
         Call renamefiles(directorylist(Cstr(Count)),extension)
      Next
      
   Else
      Messagebox "Verarbeitung wurde abgebrochen", 16 , "ACHTUNG"
   End If
SubRoutines:
Sub finddirectories(basedir As String)
   ' finds all directory entries and subentries in a given path
   Dim filename As String
   Dim fileattribute As Integer
   Dim isdir As Integer
   Dim fromcount As Integer
   Dim setfirstentryposition As Integer
   Dim setlastentryposition As Integer
   Dim dircount As Integer
   Dim i As Integer
   
   On Error Resume Next
   
   ' save the entryposition due to the recursion
   setfirstentryposition = startentryposition   
   
   ' get the file names
   fileName = Dir$(basedir & "\*.*",16)
   Do While fileName$ <> ""
      fileattribute = Getfileattr (basedir + "\" + fileName )
      If fileattribute = 16 Then
         ' check if this is really a directory
         isdir = checkdir(basedir + "\" + Filename)
         If isdir = True Then
            If filename <> "." And filename <> ".." Then
               directorylist(Cstr(startentryposition)) = basedir & "\" & Filename
               startentryposition = startentryposition + 1
            End If
         End If
      End If
      filename = Dir$()
   Loop
   
   If setfirstentryposition < startentryposition Then
      setlastentryposition = startentryposition
      For i = setfirstentryposition To setlastentryposition -1
         Call finddirectories(directorylist(Cstr(i)))   
      Next
   End If
   
End Sub

Function checkDir( path As String ) As Integer
   
   On Error Resume Next
   
   CheckDir = False
   
   Chdrive Left( path, 1 )
   Chdir path
   
   If Curdir = path Then         
      CheckDir = True
   End If
   
End Function

Sub renamefiles(basedir,extension)
   Dim filename As String
   ' renames the files, appends the previous named extension if there is no other extension
   ' check if the 4 entry from the right side is a point
   ' get the file names
   fileName = Dir$(basedir & "\*.*",0)
   Do While fileName$ <> ""
      If Left(Right(filename,4),1) = "." Then
         If  Not Iselement(listofdoctypes(Lcase(Right(filename,3)))) Then
            Name basedir & "\" & Filename As basedir & "\" & filename & "." & Extension         
         End If
      Else
         Name basedir & "\" & Filename As basedir & "\" & filename & "." & Extension         
      End If
      filename = Dir$()
   Loop
End Sub

Wie gesagt sehr kreativ aber es hat funktioniert.
Da müsste man eigentlich nur die renameFiles etwas umschreiben und die ListofDoctypes rausschmeisen um das zum laufen zu bringen.
Zu den Trick mit dem Changedir habe ich übrigens gegriffen, weil die Attribute des Directory Eintrages nicht notwendigerweise tatsächlich zu erkennen geben ob man ein Directory oder eine Datei vor sich hat. Speziell bei Dateien ohne Endung fliegt man da mit den Windows Bordmitteln des öfteren auf die Nase.

Thomas

[adminnaddel]

@ Thomas Schulte  .... vielen Dank!

Aber ich hatte eher die Realisierung in vbs angedacht 

Aber ein schöner Ansatz von dir, doch leider in diesem Fall unpassend

lg
Andy

[sloe]

Hi,
nach zig internen Projekt-Besprechungen...

' *************************************
' C:\KillSpace2.vbs
' Ersetze Leer-Zeichen in Dateinamen und in den Unterordnern
' 18.01.05 18:23
' (C) by Sloe 2005
' *************************************

Option Explicit
Dim oFso, oFolder, oShell, objFile, objShell, objFolder, objFolderItem
Dim sPfad, NewFileName, MyFile, strNewName, objPath, intValue
Dim SearchString, SearchChar, Pos, ReplaceWith, oFolderSub, OnlyPath
Call FolderAuswahl

Sub FolderAuswahl
  Const WINDOW_HANDLE = 0
  Const NO_OPTIONS = 0
  Const OverWriteFiles = True
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "Ordner mit Bildern auswählen:", NO_OPTIONS, "C:\ d:\")
  Set objFolderItem = objFolder.Self
  sPfad = objFolderItem.Path
End Sub

Call Main

Sub Main
   Set oFso = WScript.CreateObject("Scripting.FileSystemObject")
   Set oShell = WScript.CreateObject("WScript.Shell")
   SearchChar = " "   ' Search for " ".
   Set oFolder = oFso.GetFolder(sPfad)
   ReplaceFileName oFolder
   WScript.Echo "Auftrag ausgeführt!"
End Sub

Sub ReplaceFileName(oFolder)
   For Each objFile In oFolder.Files
      SearchString = objFile.Name ' String to search in.
      ReplaceWith = "_"
      Pos = Instr(1, SearchString, SearchChar)   ' Search...
      If Len(Pos) > 0 Then
         ' Hit, now replace
         NewFileName = Replace(SearchString, SearchChar, ReplaceWith)     
         OnlyPath = Left(objFile.Path,InStrRev(objFile.Path, "\"))
         Set MyFile = oFso.GetFile(OnlyPath & SearchString)
         MyFile.Move OnlyPath & "\" & NewFileName
      End If
   Next
   For Each oFolderSub In oFolder.SubFolders
        ReplaceFileName oFolderSub
   Next
End Sub

Da gibt es bestimmt auch ne schönere Lösung, aber es funzt.
Gruß Sloe
(immer noch keine Garantie...)

[adminnaddel]

Moin liebe Gemeinde,

ich habe das Script noch um eine LogDatei erweitert!
Was ich aber dazu bräucht, wo ich derzeit aber den Wald vor Bäumen nicht sehe, ist ein ErrorHandling! Mit

On Error Resume Next
 möchte ich vermeiden, das ich ein Laufzeitfehler, bzw Zugriffverletzung bekomme, wie es leider nach 20% der Dateien passiert ist!

Jedoch soll, wenn das Script aufgrund des Errors ins nächste File springt, das mir die übersprungende Datei ins Log geschrieben wird, so kann ich später sehen, welche Datei nicht unbenamst wurde!

Script:

Option Explicit
Dim oFso, oFolder, oShell, objFile, objShell, objFolder, objFolderItem
Dim sPfad, NewFileName, MyFile, strNewName, objPath, intValue
Dim SearchString, SearchChar, Pos, ReplaceWith, oFolderSub, OnlyPath
Call FolderAuswahl

Sub FolderAuswahl
  Const WINDOW_HANDLE = 0
  Const NO_OPTIONS = 0
  Const OverWriteFiles = True
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "", NO_OPTIONS, "H:\")
  Set objFolderItem = objFolder.Self
  sPfad = objFolderItem.Path
End Sub

Call Main

Sub Main
   Set oFso = WScript.CreateObject("Scripting.FileSystemObject")
   Set oShell = WScript.CreateObject("WScript.Shell")
   SearchChar = " "   ' Search for " ".
   Set oFolder = oFso.GetFolder(sPfad)
   ReplaceFileName oFolder
   WScript.Echo "Auftrag ausgeführt!"
End Sub

Call ReplaceFileName (oFolder)

Sub ReplaceFileName(oFolder)
   For Each objFile In oFolder.Files
      SearchString = objFile.Name
      ReplaceWith = "_"
      Pos = Instr(1, SearchString, SearchChar)
      If Len(Pos) > 0 Then

         NewFileName = Replace(SearchString, SearchChar, ReplaceWith)
         OnlyPath = Left(objFile.Path,InStrRev(objFile.Path, "\"))
         Set MyFile = oFso.GetFile(OnlyPath & SearchString)
         MyFile.Move OnlyPath & "\" & NewFileName
      End If
   Next
   For Each oFolderSub In oFolder.SubFolders
        ReplaceFileName oFolderSub
   Next
End Sub

Call LogDatei
Sub LogDatei

lg
Andy

[sloe]

Error-Handling im WSH kann ganz prickelnd werden...
Könnte aber so gehen:

' *************************************
' C:\KillSpace3.vbs
' Ersetze Leer-Zeichen in Dateinamen und in den Unterordnern
' mit Log für Fehler
' 25.01.05 11:24
' Version 3
' (C) by Sloe 2005
' *************************************

Option Explicit

Const ForWriting = 2
Dim PathLogErrorFiles, ErrorFileName, ErrorReport
PathLogErrorFiles = "E:\TestKillSpace\ErrorFiles.txt"

Dim oFso, oFolder, oShell, objFile, objShell, objFolder, objFolderItem
Dim sPfad, NewFileName, MyFile, strNewName, objPath, intValue
Dim SearchString, SearchChar, Pos, ReplaceWith, oFolderSub, OnlyPath
Call FolderAuswahl

Sub FolderAuswahl
  Const WINDOW_HANDLE = 0
  Const NO_OPTIONS = 0
  Const OverWriteFiles = True
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "", NO_OPTIONS, "H:\")
  Set objFolderItem = objFolder.Self
  sPfad = objFolderItem.Path
End Sub

Call Main

Sub Main
   Set oFso = WScript.CreateObject("Scripting.FileSystemObject")
   Set oShell = WScript.CreateObject("WScript.Shell")

   Set ErrorReport = oFso.OpenTextFile(PathLogErrorFiles, ForWriting, true)
   
   SearchChar = " "   ' Search for " ".
   Set oFolder = oFso.GetFolder(sPfad)
   ReplaceFileName oFolder
   WScript.Echo "Auftrag ausgeführt!"
End Sub

Call ReplaceFileName (oFolder)

Sub ReplaceFileName(oFolder)
   For Each objFile In oFolder.Files
      SearchString = objFile.Name
      ReplaceWith = "_"
      Pos = Instr(1, SearchString, SearchChar)
      If Len(Pos) > 0 Then

         NewFileName = Replace(SearchString, SearchChar, ReplaceWith)
         OnlyPath = Left(objFile.Path,InStrRev(objFile.Path, "\"))
         Set MyFile = oFso.GetFile(OnlyPath & SearchString)
         On Error Resume Next
         MyFile.Move OnlyPath & "\" & NewFileName
    If Err.Number <> 0 Then
      Call LogDatei(SearchString)       
      Err.Clear
    End If
      End If
   Next
   For Each oFolderSub In oFolder.SubFolders
        ReplaceFileName oFolderSub
   Next
End Sub

Sub LogDatei(ErrorFileName)
   ErrorReport.WriteLine(ErrorFileName & " Grund: " & Err.Description & vbCrLf)
End Sub

Gruß
Sloe

[adminnaddel]

Hey .. vielen Dank! Lasse ich heute Nacht mal laufen! Ich weiß, das an einigen Dateien das Script sich schwer tut, dann mal schauen, ob es was schreibt!

Nochmals Danke

lg Andy