Sonstiges > Offtopic

Mit VBScript Filenames ergänzen bzw ändern

<< < (2/3) > >>

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  8) , ist halt eine „salvatorische Klausel".  ;D

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  8) gemeinsam dieses ergänzen?  :P

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  :o

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

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...)

Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete