基于文件名特定文本的VBA批量打开/关闭文件需求及代码修正

一、批量打开含指定关键词的文件 #

原代码未过滤文件名关键词，以下代码会仅打开文件名包含MTD、YTD、MainFile或DataExtract的.xlsx文件：

Public Sub Open_Target_Files()
    Dim directory As String, fileName As String
    Dim targetKeywords As Variant
    Dim keyword As Variant
    Dim isMatch As Boolean
    
    Application.ScreenUpdating = False
    
    ' 从单元格获取目标文件夹路径
    directory = Range("D2").Value
    ' 确保路径末尾带斜杠，避免拼接错误
    If Right(directory, 1) <> "\" Then
        directory = directory & "\"
    End If
    
    ' 定义需要匹配的关键词数组，方便后续修改
    targetKeywords = Array("MTD", "YTD", "MainFile", "DataExtract")
    
    fileName = Dir(directory & "*.xlsx")
    Do While fileName <> ""
        isMatch = False
        ' 检查当前文件名是否包含任意一个目标关键词
        For Each keyword In targetKeywords
            If InStr(1, fileName, keyword, vbTextCompare) > 0 Then
                isMatch = True
                Exit For
            End If
        Next keyword
        
        ' 匹配成功则打开文件
        If isMatch Then
            Workbooks.Open (directory & fileName)
        End If
        
        fileName = Dir()
    Loop
    
    Application.ScreenUpdating = True
End Sub

二、批量关闭已打开的含指定关键词的文件 #

原代码错误地通过遍历文件夹文件来关闭工作簿，正确做法是遍历已打开的工作簿集合，检查文件名是否匹配关键词：

Public Sub Close_Target_Files()
    Dim wb As Workbook
    Dim targetKeywords As Variant
    Dim keyword As Variant
    Dim isMatch As Boolean
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    ' 定义需要匹配的关键词数组
    targetKeywords = Array("MTD", "YTD", "MainFile", "DataExtract")
    
    ' 倒序遍历工作簿集合（避免关闭后集合索引变化导致漏处理）
    For i = Application.Workbooks.Count To 1 Step -1
        Set wb = Application.Workbooks(i)
        isMatch = False
        
        ' 检查当前工作簿文件名是否包含任意一个目标关键词
        For Each keyword In targetKeywords
            If InStr(1, wb.Name, keyword, vbTextCompare) > 0 Then
                isMatch = True
                Exit For
            End If
        Next keyword
        
        ' 匹配成功则关闭（可根据需求修改SaveChanges参数）
        If isMatch Then
            wb.Close SaveChanges:=True
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub

关键说明 #

• 关键词匹配使用vbTextCompare，忽略大小写；若需严格区分大小写，可改为vbBinaryCompare
• 关闭工作簿时采用倒序遍历，因为关闭一个工作簿后，集合元素索引会重新排列，正序遍历会跳过后续元素
• 打开文件时添加了路径末尾斜杠的判断，避免路径拼接错误
• 关键词使用数组存储，后续修改或添加关键词时，只需调整数组内容即可

内容的提问来源于stack exchange，提问作者mmb53