code to change file name

dennisli · Aug 4, 2004

Good morning, Guys,

I have lots of Excel files named with dates, such as Paid0604, Premium0604, 0604Part1 for June 2004 under directory C:\0604. For July 2004, I have to change the name to Paid0704, Premium0704, 0704Part1 under directory C:\0704 by manual.

Are there some codes to do this job?

Thanks lot.

Dennis

TommyGun · Aug 4, 2004

Okay, this makes a few assumptions.

Root folder will always be in following format: mmyy (0604,0704,0804)
The root month determines what the new files will be named

To use, run the UpdateFileMonth procedure. It will prompt for your prior month's file. Select the correct folder, and it will process.

Be careful though, there is no error checking for user input errors. Make sure that you select the correct folder before processing.

Option Explicit

Private Type BrowseInfo
 hWndOwner As Long
 pidlRoot As Long
 sDisplayName As String
 sTitle As String
 ulFlags As Long
 lpfn As Long
 lParam As Long
 iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "Shell32.dll" (bBrowse As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" (ByVal lItem As Long, ByVal sDir As String) As Long

Sub UpdateFileMonth()
 Dim oldFolder As String, newFolder As String

 oldFolder = BrowseForDirectory("Select Prior Month Folder")

 If oldFolder <> vbNullString Then
 RollFiles oldFolder, Right(oldFolder, 4)

 MsgBox "Complete!"
 End If
End Sub

Private Sub RollFiles(filePath As String, replaceValue As String)
 Dim fso As Object, fld As Object, subfld As Object, f As Object

 Set fso = CreateObject("Scripting.FileSystemObject")

 Set fld = fso.GetFolder(filePath)

 On Error Resume Next
 MkDir AddDate(fld.Path, replaceValue)
 On Error GoTo 0

 For Each f In fld.Files
 FileCopy f.Path, AddDate(f.Path, replaceValue)
 Next

 For Each subfld In fld.SubFolders
 RollFiles subfld.Path, replaceValue
 Next

 Set fld = Nothing
 Set fso = Nothing
End Sub

Private Function AddDate(value As String, searchFor As String) As String
 Dim tmp As String, tmpReplace As String
 Dim tmpDate As Date
 tmp = value
 tmpDate = DateValue(Left(searchFor, 2) & "/1/" & Right(searchFor, 2))
 tmpDate = DateAdd("m", 1, tmpDate)
 tmpReplace = Format(tmpDate, "mmyy")
 tmp = Replace(tmp, searchFor, tmpReplace)
 AddDate = tmp
 tmp = vbNullString
 tmpReplace = vbNullString
End Function

Private Function BrowseForDirectory(Optional title As String) As String
 Dim browse_info As BrowseInfo
 Dim item As Long
 Dim dir_name As String

 With browse_info
 .pidlRoot = 0
 .sDisplayName = Space$(260)
 .sTitle = title
 .ulFlags = 1
 .lpfn = 0
 .lParam = 0
 .iImage = 0
 End With

 item = SHBrowseForFolder(browse_info)
 If item Then
 dir_name = Space$(260)
 If SHGetPathFromIDList(item, dir_name) Then
 BrowseForDirectory = Left(dir_name, _
 InStr(dir_name, Chr$(0)) - 1)
 Else
 BrowseForDirectory = ""
 End If
 End If
End Function


This code should be placed in a standard module.

dennisli · Feb 9, 2011

Good afternoon, everyone,
This code is very useful for me for many years but now I got an error message:

Run-time error ‘70’:
Permission denied

And the following code is highlighted:

Code:

        FileCopy f.Path, AddDate(f.Path, replaceValue)

Any ideas? I appreciate your help.

Dennis

code to change file name

dennisli

Well-known Member

Excel Facts

TommyGun

MrExcel MVP

dennisli

Well-known Member

Similar threads

Forum statistics

Share this page

code to change file name

dennisli

Well-known Member

Excel Facts

TommyGun

MrExcel MVP

dennisli

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock