【vba】打开文件夹对里面的excel文件进行批处理

1、问题

需要打开某一文件夹下所有excel文件进行相同操作

2、代码

Sub FileOpen()
    Dim File As String
    Dim WB As Workbook
    Dim strPath As String, strFileName As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        '用户选择文件夹路径
        If .Show Then strPath = .SelectedItems(1) Else Exit Sub
        '如果用户为选择文件夹则退出程序
    End With
    
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    
        Application.ScreenUpdating = False '冻结屏幕，打开各个文件及关闭时屏幕不会晃瞎你
        Application.DisplayAlerts = False '文件保存和关闭时提示关闭
        File = Dir(strPath & "*.xlsx") '一次找寻路径中的excel文件，这里到底是.xlsx还是.xls，可以自己改
        Do While File <> "" '当指定路径中由文件时进行循环
            Set WB = Workbooks.Open(strPath & File) '打开符合要求的文件
            Call NumArt '进行数据操作，根据自己的操作内容修改
            ActiveWorkbook.Save '保存文件
            ActiveWorkbook.Close '关闭文件
            File = Dir '找寻下一个excel文件
        Loop
        Application.ScreenUpdating = True '解冻屏幕，让屏幕恢复正常刷新。和上面的那一句成对使用
        Application.DisplayAlerts = True '恢复文件正常提示
End Sub

Sub NumArt()
    Dim i As Integer
    Dim a As Integer
    Dim b As Integer
    
    i = 1
    Do While Range("a" & i) <> 0 '第一列单元格不为空继续执行
        Range("b" & i) = Split(Range("a" & i).Value, "K")(1) 'b列数据为a列数据去除"K"
        a = Split(Range("b" & i).Value, "+")(0) 'c列数据为b列数据去除".00"
        b = Split(Range("b" & i).Value, "+")(1)
        Range("c" & i) = a * 1000 + b
        i = i + 1
    Loop
    Columns(1).Delete '删除第一列
End Sub

3、说明

包含两个函数FileOpen()和NumArt()，其中第一个函数是打开文件的主函数，第二个函数为数据操作函数，根据需求自行定义修改。