Renaming Files

B

Bear

I have a great number of files labeled with a first name followed by a
last name and a date. I need to switch the file names and save them as
Last Name First Name followed by the date? Any suggestion on how to do
this?
 
D

Dave Peterson

Maybe....

If your file names are 3 parts each separated by a space:
John Smith 12022005.xls

Something like this might work:

Option Explicit
Sub testme01()

Dim wkbk As Workbook
Dim myFileNames As Variant
Dim NewFileName As String
Dim iCtr As Long
Dim lCtr As Long
Dim myName As String
Dim myPath As String
Dim mySplit As Variant
Dim myExtension As String
Dim resp As Long

myFileNames = Application.GetOpenFilename("Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(myFileNames) = False Then
Exit Sub
End If

For iCtr = LBound(myFileNames) To UBound(myFileNames)
'strip off .txt, .xls, .xxx
myExtension = Right(myFileNames(iCtr), 4)
myName = Left(myFileNames(iCtr), Len(myFileNames(iCtr)) - 4)

'strip off the path
For lCtr = Len(myName) To 1 Step -1
If Mid(myName, lCtr, 1) = "\" Then
'stop here
myPath = Left(myName, Len(myName) - lCtr)
myName = Mid(myName, Len(myPath) + 1)
Exit For
End If
Next lCtr

'split it into pieces
mySplit = Split97(myName, " ")
If UBound(mySplit) - LBound(mySplit) <> 2 Then
'skip this one, it's not 3 pieces
Else
'first last date
'becomes
'last first date
myName = mySplit(LBound(mySplit) + 1) & " " _
& mySplit(LBound(mySplit)) & " " _
& mySplit(UBound(mySplit)) & myExtension

resp = MsgBox(Prompt:="Rename: " & myFileNames(iCtr) & vbLf _
& " To: " & myPath & myName, Buttons:=vbYesNo)
If resp = vbNo Then
'do nothing
Else
Name myFileNames(iCtr) As myPath & myName
End If
End If

Next iCtr

End Sub

Function Split97(sStr As String, sdelim As String) As Variant
'from Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
Top