Solved

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

Posted on 2004-04-02
8
287 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.


0
Comment
Question by:rberke
  • 5
  • 3
8 Comments
 
LVL 7

Expert Comment

by:ramesh12
ID: 10743271
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

0
 
LVL 7

Expert Comment

by:ramesh12
ID: 10743281
You may have to work on the code but I think it will give you a start
0
 
LVL 7

Expert Comment

by:ramesh12
ID: 10743369
By the way once you get the required string just use format like


format(yourstring,"yyyy-MM-dd") whatever you want
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 5

Author Comment

by:rberke
ID: 10743544
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.  
0
 
LVL 7

Expert Comment

by:ramesh12
ID: 10743785
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
0
 
LVL 5

Author Comment

by:rberke
ID: 10745175
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





0
 
LVL 7

Accepted Solution

by:
ramesh12 earned 500 total points
ID: 10745387
I have used this code to recurse through all the sub folder given a root folder like this

Dim fldr As Folder
Dim filName As File
Dim fldrs As Folders
Dim i As Integer
Dim item
Dim subFldr As Folder
Dim item1
Dim zipExePath As String

baseDir = "C:\Archives"
If fs.FolderExists(baseDir) Then
    Set fldr = fs.GetFolder(baseDir)
Else
    MsgBox "Folder does not exist"
Exit Sub
End If

Dim fldrName As String


For Each item In fldr.SubFolders
     ' Your folder will be here
    Set subFldr = fs.GetFolder(item.Path)
    For Each item1 In subFldr.Files
                                      'Your files will be here
    Next

Next
0
 
LVL 5

Author Comment

by:rberke
ID: 10973581
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
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question