View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Denise Pollock Denise Pollock is offline
external usenet poster
 
Posts: 12
Default Renaming files consecutively with VBA

I have a macro to move the files from one folder to an archive folder and
rename them with the modified date. However I have some users who are trying
to run the macro several times a day, I had added an exception that if the
file already existed to add a _01 on the end. Is there a way to make it so
the macro will count up from _01, _02, _03, etc when the file already exists
until it finds an unused number?

The code does a lot of other things as well, but this is the section I am
wanting to modify.

On Error GoTo ErrHandler
For Each objFile In objFolder.Files 'for every file in the folder...
'parse the name in three pieces, file name middle and extension.
In between, insert the
'last modified date. Other options may be a native Date function
or a cell refernce to
'tag the renamed file in place of
=====Format(objFile.DateLastModified, "_mmm_dd_yy")===<<<<

'if strMid is not used, it can be removed or left as a null "" string

strName = Left(objFile.Name, Len(objFile.Name) - 4) 'remove
extension and leave name only
'strName = Range("A1") 'sample of renaming from cell A1, can by
used for strMid as well

strMid = Format(objFile.DateLastModified, "mm-dd-yy") 'insert and
format files date modified into name
'strMid = Format(Now(),"_mmm_dd_yy") 'sample of formatting the
current date into the file name

strExt = Right(objFile.Name, 4) 'the original file extension

strNewFileName = strName & strMid & strExt

strAltFileName = strName & strMid & "_01" & strExt


objFile.Move strDestFolder & "\" & strNewFileName
Continue

ErrHandler:
Debug.Print Err.Number, Err.Description
If Err.Number = 58 Then
Err.Clear
objFile.Move strDestFolder & "\" & strAltFileName
GoTo Continue