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语句，所以仅如果文件打开，它会标记它。如果您想记下每个文件，只需调整该行，无论是否打开。

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

1 个答案: