Change file names in a folder
Try this code...
Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
' Loop through the directory specified in strDirPath and save each
' file name in an array, then return that array to the calling
' procedure.
' Return False if strDirPath is not a valid directory.
Dim strTempName As String
Dim varFiles() As Variant
Dim lngFileCount As Long
On Error GoTo GetAllFiles_Err
' Make sure that strDirPath ends with a "\" character.
If Right$(strDirPath, 1) < "\" Then
strDirPath = strDirPath & "\"
End If
' Make sure strDirPath is a directory.
If GetAttr(strDirPath) = vbDirectory Then
strTempName = Dir(strDirPath, vbDirectory)
Do Until Len(strTempName) = 0
' Exclude ".", "..".
If (strTempName < ".") And (strTempName < "..") Then
' Make sure we do not have a sub-directory name.
If (GetAttr(strDirPath & strTempName) _
And vbDirectory) < vbDirectory Then
' Increase the size of the array
' to accommodate the found filename
' and add the filename to the array.
ReDim Preserve varFiles(lngFileCount)
varFiles(lngFileCount) = strTempName
lngFileCount = lngFileCount + 1
End If
End If
' Use the Dir function to find the next filename.
strTempName = Dir()
Loop
' Return the array of found files.
GetAllFilesInDir = varFiles
End If
GetAllFiles_End:
Exit Function
GetAllFiles_Err:
GetAllFilesInDir = False
Resume GetAllFiles_End
End Function
Sub RenameFiles()
Dim varFiles As Variant
Dim i As Integer
Dim strFileNameOld, strFileNameNew, strDate
Dim strDir As String
'change this to your dir
strDir = "C:\Mis documentos\12 December 2005\"
'Calls the above function
varFiles = GetAllFilesInDir(strDir)
' from zero to the size of hte array (which now contains all files in
the directory)
For i = 0 To UBound(varFiles)
' date
strDate = Format(DateSerial(Year(Date), Month(Date) - 1, 1),
"yyyy-mm")
strFileNameOld = strDir & varFiles(i)
' new file name with the file suffix (e.g. .xls) reappeneded
strFileNameNew = strDir & Left(varFiles(i), Len(varFiles(i)) - 4) &
strDate & Right(varFiles(i), 4)
Name strFileNameOld As strFileNameNew
Next i
End Sub
|