View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
cheesey_toastie cheesey_toastie is offline
external usenet poster
 
Posts: 20
Default 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