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
284 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
 
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

706 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now