Das Notes Forum
Sonstiges => Offtopic => Thema gestartet von: adminnaddel am 18.01.05 - 09:02:45
-
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
-
Okay .. Ihr da draußen ....
vielleicht habe ich mich ja wieder einmal mißverständlich ausgedrückt 8)
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
-
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
-
@sloe ....
Vielen Dank für deinen Code! Habe es im Testverzeichnis getestet und es funktioniert! ;D danke!
Aber warum sagst du: "auf eigene Gefahr"?
Habe ich etwas zu befürchten?
lg
Andy
-
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
-
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.
-
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
-
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
-
@ 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
-
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...)
-
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
-
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
-
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