vba代码 合并excel文件后面新增列，内容为文件名

在VBA（Visual Basic for Applications）中，合并Excel文件并添加新列显示文件名通常涉及到读取每个文件的内容，然后将它们追加到一个新的工作簿中。下面是一个简单的示例，说明如何做到这一点：

Sub MergeFilesAndAddFilenameColumn()
    Dim folderPath As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim newSheet As Worksheet
    Dim filename As String
    Dim i As Long
    
    '指定文件夹路径
    folderPath = "C:\YourFolder\" '请替换为你需要合并文件的实际文件夹路径
    
    '创建一个新的工作簿用于保存结果
    Set newWb = Workbooks.Add()
    Set newSheet = newWb.Worksheets(1)
    
    '设置文件名列标题
    newSheet.Cells(1, 1) = "File Name"
    
    '遍历文件夹中的所有Excel文件
    i = 2
    FilenameCol = 2 '假设我们要从第二列开始写入文件名
    For Each filename In GetFileNames(folderPath)
        '打开文件
        Set wb = Workbooks.Open(folderPath & filename)
        
        '复制第一行数据，并追加文件名
        ws = wb.Worksheets(1).Rows(1).EntireRow.Copy
        newSheet.Cells(i, FilenameCol).Resize(1, ws.Columns.Count).Value = ws.Value
        
        '关闭当前文件
        wb.Close False 'False表示不保存
        
        '移动到下一行
        i = i + 1
    Next filename
    
    '清除不需要的临时变量
    Set ws = Nothing
    Set wb = Nothing
    
    '显示消息框确认操作完成
    MsgBox "Excel files merged and file names added!", vbInformation, "Merge Result"
End Sub

'这个函数用于获取指定路径下的所有Excel文件名字
Private Function GetFileNames(ByVal path As String) As Collection
    Dim filenames As New Collection
    Dim fso As Object, folder As Object, file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(path)
    
    For Each file In folder.Files
        If Right(file.Name, 4) = ".xls" Or Right(file.Name, 4) = ".xlsx" Then
            filenames.Add file.Name
        End If
    Next file
    
    Set GetFileNames = filenames
End Function