将工作表和文件名编译到工作簿中

Question

我有一个主Excel文件，它将用作参考，从文件夹中的不同Excel文件中获取不同工作表名称的数据，

我在网上搜索了，但找不到解决方案。有没有办法获取所有工作表名称并将其从 A2 和 A1 开始每行粘贴，这将反映其文件名而不带扩展名？

这是我到目前为止所拥有的：

Sub SheetNames()
Columns(1).Insert
For I = 1 To Sheets.Count
Cells(I, 1) = Sheets(I).Name
Next I
End Sub

Answer 1

你可以试试这段代码。它将把所有内容保存在主工作簿的第一页中：

Sub SheetNames()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim currentWorkbook, wb As Workbook
Dim i, j As Integer
Set currentWorkbook = ActiveWorkbook
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the current folder object
Set objFolder = objFSO.GetFolder(currentWorkbook.Path)
i = 1
j = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'we filter filenames, so we get only excel files
'note that second condition is to prevent from using cached workbook associated with opened workbook
'it starts with ~$
If objFile.Name Like "*.xlsx" And Not objFile.Name Like "~$*.xlsx" _
And Not objFile.Name = currentWorkbook.Name Then
'get the name of a workbook in the first row
currentWorkbook.Worksheets(1).Cells(1, i).Value = objFile.Name
'open workbook
Set wb = Workbooks.Open(currentWorkbook.Path & "/" & objFile.Name)
'loop through sheets and get their names into cells
For j = 2 To wb.Worksheets.Count + 1
currentWorkbook.Worksheets(1).Cells(j, i).Value = wb.Worksheets(j - 1).Name
Next
'close workbook without saving changes
wb.Close (False)
i = i + 1
End If
Next objFile
End Sub