Hi Norman, it works perfectly on the "C" drive, but mine are on the network.

I am assuming it needs something extra ??

Hi Les,

=============
Hi Norman, thanks for the help. I get an error at the end of the function.

RUN-TIME-ERROR: "13"

"Type Mismatch" ?
=============

The code works without problem for me,
provided that each xls file in the folder has
a worksheet named "Sheet1" and that cell
A1 of each Sheet1 contains a valid file
name (without an extension).

Although this has no bearing on your
problem, replace your code with the
following version:

'===========>
Option Explicit

'-------------->>
Private Sub RenameFiles()
   Dim oFSO As Object
   Dim oFolder As Object
   Dim ofile As Object
   Dim oFiles As Object
   Dim sPath As String
   Dim sName As String
   Dim iLen As Long
   Dim Res As String
   Const sSheet As String = "Sheet1"   '<<===== CHANGE
   Const sCell As String = "A1"           '<<===== CHANGE
   Const sExt As String = ".xls"            '<<===== CHANGE

  On Error GoTo RenameFiles_Error

   sPath = "C:\Users\Norman\" _
                      & "Documents\Test"    '<<===== CHANGE

   Set oFSO = CreateObject("Scripting.FileSystemObject")
   Set oFolder = oFSO.GetFolder(sPath)
   Set oFiles = oFolder.Files

   iLen = Len(sExt)
'    On Error GoTo XIT
   For Each ofile In oFiles
       With ofile
           sName = .Name
           If UCase(Right(sName, iLen)) = UCase(sExt) Then
               Res = GetValue(sPath, sName, sSheet, sCell)
               Name sName As Res & sExt
           End If
       End With
   Next ofile

XIT:
   Set oFiles = Nothing
   Set oFolder = Nothing
   Set oFSO = Nothing
  On Error GoTo 0
  Exit Sub

RenameFiles_Error:
   MsgBox "Error " & Err.Number _
   & " (" & Err.Description & ") " _
   & "in procedure RenameFiles"
   
End Sub

'------------>>
Private Function GetValue(path, file, sheet, ref)
'======================
'\\ John Walkenbach
'\\ http://www.j-walk.com/ss/excel/tips/tip82.htm
'\\ Retrieves a value from a closed workbook
'======================
   Dim arg As String

'   Make sure the file exists
   If Right(path, 1) <> "\" Then path = path & "\"
   If Dir(path & file) = "" Then
       GetValue = "File Not Found"
       Exit Function
   End If

'   Create the argument
   arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
     Range(ref).Range("A1").Address(, , xlR1C1)

'   Execute an XLM macro
   GetValue = ExecuteExcel4Macro(arg)
End Function

'<===========

---
Regards.
Norman