在几个文件中创建范围名称

Question

我试图在一些excel文件中创建一个范围名称，然后将文件名和路径写入另一个excel。文件/路径被正确写入，但范围名称似乎并未在文件中创建。你能告诉我我要去哪里吗？

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

我测试了这个，它似乎适用于我。主要的想法是与工作簿/工作表和你在打电话给他们什么更明确：

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 

小记：我不得不改变... = "xls*" Or Right ...到... = "xlsx" Or ...，因为某种原因，它不会打开.xlsx文件。好奇。无论如何，让我知道如果你有任何错误或奇怪的问题！

而且，我搬到哪里你保存工作簿的名称和路径内的If声明的一部分，所以只有当文件打开，将其标记它。只要调整该行，如果你想记下每一个文件，不管它是否打开。