Change file names in a folder

[TISR]

Hi to all
I am trying to change the names of all the files in a folder by putting a
new month and year at the end of each file name using the following code:

Dim f as String, s as String
Const Dest = "C:\Mis documentos\12 December 2005\"
f = dir(Dest & "*.*")
do while f <> ""
s = Mid(f, 1, (Len(f) - 9)) & _
Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm")
Name Dest & f As Dest & s
f = dir()
Loop

It gets stuck in the following code:
Name Dest & f As Dest & s
Then I tried:
Name f As s
It Didn´t work. then I tried:
Name f As Dir(Dest & s)
It didn´t work
The message keeps on saying that it cannot find the root directory access.
Any solutions or ideas? It would be appreciated.
Regards
TISR

 

[Ron de Bruin]

Hi TISR

Post a few of your file names in that folder

 

[cheesey_toastie]

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