We help IT Professionals succeed at work.

Rename files and folders from  mm-dd-yy to yyyy-mm-dd (e.g. "test 03-05-04trial1"  to "test 2004-03-04trial1"

rberke
rberke asked
on
360 Views
Last Modified: 2010-05-02
My Windows 2000 server has about 500 folders with 2000 files.

I want to change the naming convention so dates are yyyy-mm-dd instead of the current variety of mm-dd-yy.

The input names can be  mm-dd-yy  m-d-yy  mm-d-yy or m-dd-yy.
The delimiters can be spaces, letters etc.  Basically anything except a number.  
Both folders names and file names have to be changed.

old name                                          new name
test 03-05-04trial1                 |    test 2004-03-05trial1
test3-05-04 after 3-01-04       |     test2004-03-05 after 2004-03-01
test 3-5-04 trial3                   |      test 2004-03-05 trial3
test93-5-04 trial after3-01-04 |     test93-5-04 trial after3-01-04   (notice 93-5-4 doesn't get changed because it is not a valid date by my definition.

Does anybody have a good code segment that does something like this.  I'm enough of a programmer that I can modify it to finish the job.


Comment
Watch Question

Commented:
try something like this

function getDateStr(str1 as string) as string

for i=1 to len(str1)

  if  isnumeric(mid(str1,i,1)) then
         startpos=i        
         if isnumeric(mid(str1,startpos+7)) then
            endpos=startpos+7
         elseif isnumeric(mid(str1,startpos+6)) then
            endpos=startpos+6
         end if
getDateStr=mid(str1,startpos,endpos)
  exit for

  end if
next

Commented:
You may have to work on the code but I think it will give you a start

Commented:
By the way once you get the required string just use format like


format(yourstring,"yyyy-MM-dd") whatever you want
rberkeConsultant

Author

Commented:
sorry, I should have been clearer.  I was also hoping for fso logic to walk through the file folders and issue the renames.  

Actually, the FSO is the more important portion of my question.


I've seen some logic in my research, but most of it either renames folder names, or rename file names, not both.

Normally I would merge fso logic myself, but I'm up to my eyeballs doing other stuff for the next few days, so I'm hoping someone can help me out.  

Commented:
something like this

set fs=createobject("scripting.filesystemobject")

dim subFldr as folder

folderpath=youfolderpath

    Set subFldr = fs.GetFolder(folderpath)
    For Each item1 In subFldr.Files

       strDate=getDateStr(mid(item1.path,instrrev(item1.path,"\")+1)

   next


function getDateStr(str1 as string) as string

for i=1 to len(str1)

  if  isnumeric(mid(str1,i,1)) then
         startpos=i        
         if isnumeric(mid(str1,startpos+7)) then
            endpos=startpos+7
         elseif isnumeric(mid(str1,startpos+6)) then
            endpos=startpos+6
         end if
getDateStr=mid(str1,startpos,endpos)
  exit for

  end if
next
end function
rberkeConsultant

Author

Commented:
The following code translates the name pretty well, so nobody should make any further comments on that portion of my problem.

Now can anybody give me a recusive program that will allow me to choose a folder, then rename every object under that folder?  Recursively of course so that all subfolders and files get renamed.

----- here is the newname logic in case anybody cares -------------
Option Explicit

Sub test()
Dim s
s = InputBox("x", "y", newname("test2-2-03 02-03-04"))
End Sub

Function newname(ByVal inName)
' converts strings with mm-dd-yy format into yyyy-mm-dd format
' but only if the date is a valid date
' e.g. CONVERTS "test2-2-03 02-03-04" INTO "test2003-02-02 2004-02-03"

Dim s, i, swapped, pattrn, start, size, arydate, myerr

inName = "x" & inName & "x"
s = inName

For i = 1 To Len(s)
    Select Case Mid(s, i, 1)
    Case "0" To "9": Mid(s, i, 1) = "9"
    Case "-": Mid(s, i, 1) = "-"
    Case Else: Mid(s, i, 1) = "x"
    End Select
Next i


again:
swapped = False

For Each pattrn In Array("x9-9-99x", "x9-99-99x", "x99-9-99x", "x99-99-99x")
    start = InStr(s, pattrn)
    size = Len(pattrn)
   
    If start > 0 Then
        Mid(s, start, Len(pattrn)) = Left("xxxxxxxxxxxxxxx", size)
        On Error Resume Next
        arydate = CDate(Mid(inName, start + 1, size - 2))
        myerr = Err
        On Error GoTo 0
        If myerr <> 0 Then arydate = #1/1/1993#
        If arydate >= #1/1/1999# And arydate < _
            DateSerial(Year(Now()) + 3, 1, 1) Then
         ' ------- swap the date
         inName = Left(inName, start) & Format(arydate, "yyyy-mm-dd") _
            & Mid(inName, start + size - 1)
         
         s = Left(s, start) & "9999-99-99" _
           & Mid(s, start + size - 1)
         swapped = True
        End If
 
    End If
Next pattrn
If swapped Then GoTo again
newname = Mid(inName, 2, Len(inName) - 2)

End Function





Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
rberkeConsultant

Author

Commented:
Thanks for your help.

this seems to work pretty well


Dim fso As New FileSystemObject
Option Explicit
Private Sub testit()
Dim s, i

s = Application.GetSaveAsFilename("Browse into folder then click save", Title:="Rename all objects")
If s = False Then Exit Sub

For i = Len(s) To 1 Step -1
    If Mid(s, i, 1) = "\" Then
        s = Left(s, i)
        Exit For
    End If
Next i
    Call ChangeNTFSNames(s)
MsgBox "rename done"
End Sub

Private Sub ChangeNTFSNames(ByVal sFol As String)
    Dim fld As Folder
    Dim subf As Object
    Dim myfile As Object
    Dim strNewName As String
   Set fld = fso.GetFolder(sFol)
   Dim myline As Integer
   Dim TotalFiles As Long

   Set fld = fso.GetFolder(sFol)
   For Each subf In fld.SubFolders
        ChangeNTFSNames (subf.Path)
        strNewName = newname(subf.Name)
        If strNewName <> subf.Path Then
                        Name subf.Path As Left(subf.Path, Len(subf.Path) _
                - Len(subf.Name)) & strNewName
        End If
    Next subf
   For Each myfile In fld.Files
        strNewName = newname(myfile.Name)
        If strNewName <> myfile.Name Then
            Name myfile.Path As Left(myfile.Path, Len(myfile.Path) _
                - Len(myfile.Name)) & strNewName
        End If
    Next myfile
   Exit Sub
Catch: Debug.Print "  error at", myline, sFol & " " & Err.Number & Err.Description
Resume Next
End Sub
Function newname(ByVal inName)
' converts strings with mm-dd-yy format into yyyy-mm-dd format
' but only if the date is a valid date
' e.g. CONVERTS "test2-2-03 02-03-04" INTO "test2003-02-02 2004-02-03"

Dim s, i, swapped, pattrn, start, size, arydate, myerr

inName = "x" & inName & "x" ' if inName is "xmy file of 3-2-04x'
s = inName                                '  then s is        "xxxxxxxxx9-9-99x"
For i = 1 To Len(s)
    Select Case Mid(s, i, 1)
    Case "0" To "9": Mid(s, i, 1) = "9"
    Case "-": Mid(s, i, 1) = "-"
    Case Else: Mid(s, i, 1) = "x"
    End Select
Next i

again:
swapped = False

For Each pattrn In Array("x9-9-99x", "x9-99-99x", "x99-9-99x", "x99-99-99x")
    start = InStr(s, pattrn)
    size = Len(pattrn)
    If start > 0 Then   ' if x9-9-99x is in the file name, see if it should be changed
        Mid(s, start, Len(pattrn)) = Left("xxxxxxxxxxxxxxx", size)  ' change xxx9-9-99x to xxxxxxxxxx"
        On Error Resume Next
        arydate = CDate(Mid(inName, start + 1, size - 2))
        myerr = Err
        On Error GoTo 0
        If myerr <> 0 Then arydate = #1/1/1993#
        If arydate >= #1/1/1999# And arydate < _
            DateSerial(Year(Now()) + 3, 1, 1) Then
         ' ------- swap the date
         inName = Left(inName, start) & Format(arydate, "yyyy-mm-dd") _
            & Mid(inName, start + size - 1)
         s = Left(s, start) & "9999-99-99" _
           & Mid(s, start + size - 1)
         swapped = True
        End If
    End If
Next pattrn
If swapped Then GoTo again
newname = Mid(inName, 2, Len(inName) - 2)

End Function
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.