' rename2date.vbs ' Rename the current/selected files and directories by adding the date ' 25.03.2010 th. ' 31.08.2010 KNUT Dim Items Dim Fso, Item, OverwriteAnswer, Overwrite Set Fso = CreateObject("Scripting.FileSystemObject") OverwriteAnswer = 0 'Copy or rename Set Form1 = Salamander.Forms.Form("Only Rename or Copy to an new file?") Form1.b1 = Salamander.Forms.Button("&Copy", 3) Form1.b2 = Salamander.Forms.Button("&Rename", 4) Result = Form1.Execute Select Case Result Case 3 DOCOPY = True Case 4 DOCOPY = False End Select If Path <> "" Then DOCOPY = False '--- Identify the item(s) to rename If Salamander.SourcePanel.SelectedItems.Count = 0 Then If Salamander.SourcePanel.FocusedItem.Name <> ".." then RenameItem Salamander.SourcePanel.FocusedItem, False Else Salamander.MsgBox "Please select or focus an item first.",0,"Rename" Salamander.AbortScript() End If Else Set Items = Salamander.SourcePanel.SelectedItems End If If VarType(Items) <> 0 Then ' vbEmpty '--- Set up progress dialog Salamander.ProgressDialog.Style = 1 Salamander.ProgressDialog.Maximum = Items.Count Salamander.ProgressDialog.Show Salamander.ProgressDialog.AddText "Renaming ..." ' Iterate through the item collection rename each item For Each Item In Items RenameItem Item, True If Salamander.ProgressDialog.IsCancelled then Salamander.AbortScript() ' Canceled Next End If Sub RenameItem(Item, ShowProgress) If Item.Name <> ".." Then IsDirectory = (Item.Attributes And 16) <> 0 OldFilename = Salamander.SourcePanel.Path & "\" & Item.Name 'Salamander.MsgBox Item.DateLastModified SplitFilenameAndExtension Item.Name, OldName, OldExtension ' Build the new name for the item - this has to be adapted! YMD = Item.DateLastModified YMD1 = InStr (1, YMD, ".") YMD2 = InStr (YMD1+1, YMD, ".") YMDMON = "0" & mid(YMD,YMD1+1,YMD2-YMD1-1) YMDDAY = "0" & mid(YMD,1,YMD1-1) 'Salamander.MsgBox YMD & "#" & YMD1 & "#" & YMD2 & "#" & YMDDAY & "#" & YMDMON NewFilename = Salamander.SourcePanel.Path & "\" & _ OldName & "_" & mid(YMD,YMD2+1,4) & "-" & Right(YMDMON,2) & "-" & Right(YMDDAY,2) If OldExtension <> "" Then NewFilename = NewFilename & "." & OldExtension If ShowProgress Then Salamander.ProgressDialog.Step(1) Salamander.ProgressDialog.AddText vbCrLf & OldFilename & " --> " & NewFilename End If Overwrite = True If Fso.FileExists(NewFilename) Then 'neither "skip all" nor "all" has been pressed before, ask If OverwriteAnswer < 17 then _ OverwriteAnswer = Salamander.OverwriteDialog(NewFilename, OldFilename, 4) Select Case OverwriteAnswer Case 2 Salamander.AbortScript() ' Cancel Case 7, 16, 17 Overwrite = False Case Else ' Overwrite, target has to be deleted If IsDirectory then Fso.DeleteFolder NewFilename Else Fso.DeleteFile NewFilename End If End Select End If If Overwrite then If DOCOPY then If IsDirectory Then Fso.CopyFolder OldFilename, NewFilename Else Fso.CopyFile OldFilename, NewFilename End If Else If IsDirectory Then Fso.MoveFolder OldFilename, NewFilename Else Fso.MoveFile OldFilename, NewFilename End If End If End If End If End Sub Sub SplitFilenameAndExtension(FileName, Name, Extension) Dim n For n = Len(FileName) to 1 step -1 If Mid(FileName, n, 1) = "." Then Exit For Next if n < 1 then Name = FileName Extension = "" Else Name = Left(FileName, n - 1) Extension = Mid(FileName, n + 1) End If End Sub