Create range name in several files - excel

Question

I'm trying to create a range name in a number of excel files, and then write the file names and paths out to another excel. The files/paths are written correctly, but the range name doesn't appear to be created in the file. Can you tell me where I'm going wrong?
Sub directlisting()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim cell As Range
Dim RangeName As String
Dim CellName As String
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("\\xxxxxxxxxxx\testdata\Transfer")
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'open file if an Excel file
If Right(objFile, 4) = "xls*" Or Right(objFile, 3) = "xl*" Then
Application.Workbooks.Open (objFile)
'create range name
RangeName = "PVS"
CellName = "A4:AG27"
Set cell = Worksheets("PVS").Range(CellName)
objFile.Names.Add Name:=RangeName, RefersTo:=cell
'Save the file
Application.DisplayAlerts = False
objFile.Save
objFile.Close
Application.DisplayAlerts = True
End If
'print file name
Cells(i + 1, 1) = objFile.Name
'print file path
Cells(i + 1, 2) = objFile.path
i = i + 1
Next objFile
End If
End Sub

Answer 1

I tested this and it seemed to work for me. The main idea was to be more explicit with the workbook/worksheets and what you're calling them on:
Sub directlisting()
Dim objFSO As Object, objFolder As Object, objFile As Object
Dim cell As Range
Dim RangeName As String, CellName As String
Dim i As Integer
Dim tempWB As Workbook, mainWB As Workbook
Dim mainWS As Worksheet
'Assuming this is running from a "main" workbook
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.ActiveSheet
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\User\Documents\Test") ' CHANGE TO YOUR PATH
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'open file if an Excel file
If Right(objFile, 4) = "xlsx" Or Right(objFile, 3) = "xl*" Then
Set tempWB = Application.Workbooks.Open(objFile)
'create range name
RangeName = "PVS"
CellName = "A4:AG27"
Set cell = tempWB.Worksheets("PVS").Range(CellName)
'ActiveWorkbook.Names.Add Name:="PVS", RefersToR1C1:="=PVS!R11C8:R18C14"
tempWB.Names.Add Name:=RangeName, RefersTo:=cell
'print file name
mainWS.Cells(i + 1, 1) = tempWB.Name
'print file path
mainWS.Cells(i + 1, 2) = tempWB.Path
i = i + 1
'Save the file
Application.DisplayAlerts = False
tempWB.Save
tempWB.Close
Application.DisplayAlerts = True
End If ' Right (objFile, 4) ...
Next objFile
End Sub
Small note: I had to change the ... = "xls*" Or Right ... to ... = "xlsx" Or ..., because for some reason it wouldn't open the .xlsx file. Curious. In any case, let me know if you get any errors or weird issues!
Also, I moved the part where you save the workbook name and path inside the If statement, so only if the file opens, will it mark it. Just tweak that line if you want to note every file, whether or not it opens.