Rename all workbooks in folder - vba

Question

I am trying to rename all workbooks in a folder, based on the value of a cell in each file (basically reports dates). The xls files are saved from the internet in a folder. I wrote the code below but it's not working... workbooks.open fail and wb.name seems to not work either.
Sub openrenamebook()
Dim FileExtension As String, FilesInFolder As String
Dim FolderPath As String
Dim wb As Workbook
FileExtension = "*xls"
FolderPath = "N:\MyFolder\"
FilesInFolder = Dir(FolderPath & FileExtension)
Do While FilesInFolder <> ""
Set wb = Workbooks.Open(Filename:=FolderPath & FilesInFolder, ReadOnly:=False)
wb.Name = Mid(wb.Sheets(1).Cells(1, 2).Value, 38, 2)
wb.Close True
FilesInFolder = Dir
Set wb = Nothing
Loop
End Sub

Answer 1

You cannot rename a file by changing the Workbook Name property. But you can use the FileSystemObject.
A reference to Microsoft Scripting Runtime is required for this code to work.
I cannot fully test because I do not know what file paths are specified in your worksheet. It assumes they're valid
Sub Test()
Dim FSO As New FileSystemObject
Dim FileItem As File
Dim wb As Workbook
Dim strRenameValue As String
FolderPath = "N:\MyFolder\"
'Loop Files
For Each FileItem In FSO.GetFolder(FolderPath).Files
Set wb = Workbooks.Open(FileItem.Path)
'Get The Value With Which To Rename The Workbook
strRenameValue = Mid(wb.Sheets(1).Cells(1, 2).Value, 38, 2)
'You shouldn't need to save?
wb.Close False
'Now That The File Is Closed, Rename It
FileItem.Name = strRenameValue
Set wb = Nothing
Next FileItem
End Sub

Answer 2

Since you plan to rename the files, I would suggest that you start by loading all the names into an array before renaming the files, in order to get coherent values from Dir.
I do that using the following function:
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
'Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function

Answer 3

This version uses a separate instance for speed (I did consider using ADO instead).
Also ensures only Excel files are opened and that the new filename is valid (I do assume that you have a valid suffix file type, ie .xlsx in your cell names)
Sub openrenamebook()
Dim xlApp As Excel.Application
Dim FileExtension As String
Dim FilesInFolder As String
Dim FolderPath As String
Dim strRenameValue As String
Dim wb As Workbook
Set xlApp = New Excel.Application
With xlApp
.Visible = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
FileExtension = "*.xls*"
FolderPath = "c:\temp\"
FilesInFolder = Dir(FolderPath & FileExtension)
Do While Len(FilesInFolder) > 0
Set wb = xlApp.Workbooks.Open(FolderPath & FilesInFolder)
On Error Resume Next
strRenameValue = Mid$(wb.Sheets(1).Cells(1, 2).Value, 38, 2)
On Error GoTo 0
wb.Close False
If Len(strRenameValue) > 0 Then Name FolderPath & FilesInFolder As FolderPath & strRenameValue
Set wb = Nothing
FilesInFolder = Dir
Loop
xlApp.Quit
Set xlApp = Nothing
End Sub