VBA遍历指定文件夹的所有文件

VBA遍历指定文件夹的所有文件（包括子目录）
1.添加引用：Microsoft Scripting Runtime

2.定义一个遍历文件的过程，过程需要传递一个文件夹变量
'遍历文件的过程，并填充到工作表
Sub LookUpAllFiles(fld As Folder)
    Dim fil As File, outFld As Folder    '定义一个文件夹和文件变量
    Set subfiles = fld.Files()     '获取文件夹下所有文件
    Set SubFolders = fld.SubFolders      '获取文件夹下所有文件夹
    For Each fil In fld.Files     '遍历文件
        n = n + 1
        Range("a" & n).Value = fil.Name     '把文件名填充到数据表
    Next
    For Each outFld In SubFolders    '遍历文件夹
        LookUpAllFiles outFld      '调用函数自身
    Next
End Sub
12345678910111213
这里有一个公共变量，需要在函数外定义
Private n As Integer

4.然后，显示一个输入对话框，输入文件名，就能遍历所有文件了
Sub demo()
    Dim fso As New FileSystemObject  '定义一个文件系统对象
    Dim fld As Folder, sr As String
    n = 0
    sr = InputBox("请输入文件路径")     '显示一个文本框输入文件名
    If fso.FolderExists(sr) Then        '判断文件是否存在
        Range("a:a").ClearContents
        Set fld = fso.GetFolder(sr)
        LookUpAllFiles fld         '调用函数
    Else
        MsgBox "文件夹不存在"
    End If
End Sub

————————————————
版权声明：本文为CSDN博主「孤寂远行」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。
原文链接：https://blog.csdn.net/weixin_43154777/java/article/details/85335762

读取指定目录的excel文件

Dim wb as workbook

set wb = getobject(具体路径bai+文件)

with wb

.............(operation on wb)

end with

wb.close false

set wb=nothing

------------

    Dim Path As String

    Dim File As String

    Dim WB As Workbook

    Dim c1 As Single

    Dim d2 As Single

    Dim d3 As Single

    Dim d4 As Single

    mypa = ThisWorkbook.Path & "\"

       Cells(10, 2) = "正在处理，请耐心等待..."

        Application.ScreenUpdating = False '冻结屏幕，打开各个文件及关闭时屏幕不会晃瞎你的狗眼

       ' Path = "c:\temp\" '把目标文件夹路径赋值给变量，这里的路径可以自己改

        File = Dir(mypa & "*.xlsx")  '一次找寻路径中的excel文件，这里到底是.xlsx还是.xls，可以自己改

        Do While File <> "" '当指定路径中由文件时进行循环

            Set WB = Workbooks.Open(mypa & File) '打开符合要求的文件

            'Call 你的具体操作宏 '调用你的另一端对每个excel文件进行具体操作的宏，也可以直接写到这个宏中

            r = 2

          Do While WB.Sheets(1).Cells(r, 104) <> ""

            c1 = WB.Sheets(1).Cells(r, 104)

            d2 = WB.Sheets(1).Cells(r, 106)

            'xinxi = "批准宅基地使用权面积：150㎡；批准使用权上房屋建筑面积：213.02㎡。超出宅基地使用权面积：203.16㎡；超出宅基地使用权上房屋建筑面积：0㎡。"

            xinxi = "批准宅基地使用权面积：" & c1 & "㎡；"

            xinxi = xinxi & "批准使用权上房屋建筑面积：" & d2 & "㎡；"

            ...

            WB.Sheets(1).Cells(r, 110) = xinxi

            r = r + 1

            DoEvents

          Loop

            'MsgBox WB.Name

            WB.Save

            WB.Close

            File = Dir '找寻下一个excel文件

        Loop

        Application.ScreenUpdating = True '解冻屏幕，让屏幕恢复正常刷新。和上面的那一句成对使用

        Cells(10, 2) = "处理完毕！"

        MsgBox "已处理完成"