Excel VBA - 遍历某个文件夹中文件、文件夹及批量建立txt

我们可能会经常要将一个文件夹中的所有文件都遍历一遍,然后进行修改,下面就介绍用Dir函数实现遍历*.xlsx文件的方法

Dir 函数

返回一个 String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。

语法

Dir[(pathname[, attributes])]

第一个参数即是文件的地址,第一次引用的时候要标注,第二次用的时候就不必指出了,下面举个例子,遍历下面文件夹中的Excel2010文件,然后输出文件的名字~

 批量遍历某类文件(*.xlsx) 

Sub OpenAndClose()
    Dim MyFile As String
    Dim s As String
    Dim count As Integer
    MyFile = Dir("C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & "*.xlsx")
    '读入文件夹中的第一个.xlsx文件
    count = count + 1       '记录文件的个数
    s = s & count & "、" & MyFile
    Do While MyFile <> ""
        MyFile = Dir        '第二次读入的时候不用写参数
        If MyFile = "" Then
            Exit Do         '当MyFile为空的时候就说明已经遍历完了,这时退出Do,否则还要运行一遍
        End If
        count = count + 1
        If count Mod 2 <> 1 Then
            s = s & vbTab & count & "、" & MyFile
        Else
            s = s & vbCrLf & count & "、" & MyFile
        End If
    Loop
    Debug.Print s
End Sub

运行结果如下:

53、

遍历每个文件,并且修改文件,先将文件的名字存在数组中,然后通过数组遍历打开每个文件,修改,再关闭文件~

Sub OpenCloseArray()
    Dim MyFile As String
    Dim Arr(100) As String
    Dim count As Integer
    MyFile = Dir("C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & "*.xlsx")
    count = count + 1
    Arr(count) = MyFile
    
    Do While MyFile <> ""
        MyFile = Dir
        If MyFile = "" Then
            Exit Do
        End If
        count = count + 1
        Arr(count) = MyFile         '将文件的名字存在数组中
    Loop
    
    For i = 1 To count
        Workbooks.Open Filename:="C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & Arr(i)  '循环打开Excel文件
            Cells(1, 1) = "alex_bn_lee"             '修改打开文件的内容
        ActiveWorkbook.Close savechanges = True     '关闭打开的文件
    Next
End Sub

要是想要修改每个工作簿的内容可以这样遍历一下,显示将文件夹中的工作簿的名字存到一个字符串数组中,然后在用For...Next语句遍历

 批量遍历某个文件夹中的所有文件(*.*) 

注意:遍历的时候,顺序完全是按照文件名的顺序排的,而不是按照文件夹中文件的顺序~

Sub dlkfjdl()
    Dim MyFile As String
    Dim count As Integer
    count = 1
    MyFile = Dir("C:\Users\McDelfino\Desktop\桌面\Excel\*.*")
    Debug.Print "1、" & MyFile
    Do While MyFile <> ""
        count = count + 1
        MyFile = Dir
        If MyFile = "" Then Exit Do
        Debug.Print count & "、" & MyFile
    Loop
End Sub

 批量建立TXT文件  

批量建立,同时可以批量赋值到文本文件中~

Sub kdjfl()
    For i = 1 To 10
        Open "C:\Users\McDelfino\Desktop\练习\" & Format(i, "00") & ".txt" For Output As #i
        Print #i, i
        Close #i
    Next
End Sub

 GetFolder方法

返回一个和指定路径中文件夹相对应的 Folder 对象。应用于FileSystemObject对象~

 遍历文件夹内的所有文件 

Sub GetFiles()
    Dim fs, f, f1, fc
    Set fs = CreateObject("scripting.filesystemobject")
    Set f = fs.getfolder("F:\Desktop\2.wind_numerical_excello")
    Set fc = f.Files

    For Each f1 In fc
        Debug.Print f1
        Debug.Print "f1 = " & TypeName(f1)
    Next
    
    MsgBox "fs = " & TypeName(fs) _
    & vbCrLf & "f = " & TypeName(f) _
    & vbCrLf & "fc = " & TypeName(fc)
    
End Sub

fs = FileSystemObject对象:提供对计算机文件系统的访问。

f = Folder对象:提供对一个文件夹所有属性的访问。

fc = Files集合:在一个文件夹内的所有 File 对象的集合。

f1 = File对象:提供对文件所有属性的访问。

 FileSystemObject对象及TextStream对象的方法举例:

Sub djkflds()
    Dim fso, fd, fs, f, ft, s
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    fso.MoveFile "F:\Desktop\1.xlsx", "F:\Desktop\2.wind_numerical_excello\1.xlsx"
    '移动文件
     
    fso.MoveFolder "F:\Desktop\temp", "F:\Desktop\2.wind_numerical_excello\temp"
    '移动文件夹
    
    MsgBox fso.FileExists("F:\Desktop\1.xlsx")
    '判断文件是否存在,存在返回True,否则返回False
    
    MsgBox fso.FolderExists("F:\Desktop\temp")
    '判断文件夹是否存在,存在返回True,否则返回False
   
    Set ft = fso.OpenTextFile("F:\Desktop\1.txt", 8, -2)
    '8打开一个文件并写到文件的尾部 -2使用系统缺省打开文件
    'ft是TextStream对象,加快对文件的顺序访问
    ft.Write "Hello World"      'Write方法,在一行上
    For i = 1 To 10
        ft.WriteLine i          'WriteLien方法,另起一行
    Next
    ft.Close                    'Close方法,关闭文件
    
    fso.DeleteFolder "F:\Desktop\1"
    '删除一个文件夹,并且是不放在回收站里面的

End Sub


  Folder对象的属性和方法举例:


 Size方法

Sub GetSize()
    Dim fso, fd, fs, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fd = fso.GetFolder("F:\Desktop\2.wind_numerical_excello")
    Set fs = fd.SubFolders
    For Each f In fs
        Debug.Print f.Name, Format(f.Size / 1024 / 1024, "#.##") & "M"
    Next
End Sub


  File对象的属性和方法举例:

属性和方法与Folder对象类似~


遍历文件夹中的子文件夹及文件

Sub getfiles()
    Dim fso, folder, fds, fd, folder2, fs, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder1 = fso.GetFolder("F:\Desktop\2.wind_numerical_excello")  '获得文件夹
    Set fds = folder1.subfolders        '子文件夹集合
    For Each fd In fds                  '遍历子文件夹
        Debug.Print fd.Name
        Set folder2 = fd                '获得文件夹2
        Set fs = folder2.Files          '文件集合
        For Each f In fs                '遍历文件
            Debug.Print f.Name
        Next
        Debug.Print
    Next
End Sub


  • 18
    点赞
  • 168
    收藏
    觉得还不错? 一键收藏
  • 12
    评论
VBA遍历文件夹Excel文件可以通过使用FileSystemObject对象来实现。首先,你需要引用Microsoft Scripting Runtime库,然后使用下面的代码: ```vba Sub 遍历文件夹Excel() Dim FSO As Object Dim folderPath As String Dim folder As Object Dim file As Object Dim wb As Workbook ' 设置文件夹路径 folderPath = "你的文件夹路径" ' 创建FileSystemObject对象 Set FSO = CreateObject("Scripting.FileSystemObject") ' 获取文件夹对象 Set folder = FSO.GetFolder(folderPath) ' 遍历文件夹文件 For Each file In folder.Files ' 检查文件类型是否为Excel文件 If FSO.GetExtensionName(file.Name) = "xlsx" Or FSO.GetExtensionName(file.Name) = "xls" Then ' 打开Excel工作薄 Set wb = Workbooks.Open(file.Path) ' 在这里添加你需要执行的操作 ' ... ' 关闭并保存工作薄 wb.Close SaveChanges:=True End If Next file ' 释放对象 Set folder = Nothing Set file = Nothing Set FSO = Nothing End Sub ``` 上述代码使用了FileSystemObject对象来获取指定文件夹下的所有文件,并逐个打开并进行操作。你可以根据需要在"在这里添加你需要执行的操作"的部分进行相应的操作,比如修改文件名、读取数据等。记得在操作完成后关闭并保存工作薄。<span class="em">1</span><span class="em">2</span><span class="em">3</span> #### 引用[.reference_title] - *1* [【VBAExcelVBA遍历当前目录下指定类型的excel文件并复制文件指定的内容到新表](https://blog.csdn.net/weixin_38263568/article/details/73608719)[target="_blank" data-report-click={"spm":"1018.2226.3001.9630","extra":{"utm_source":"vip_chatgpt_common_search_pc_result","utm_medium":"distribute.pc_search_result.none-task-cask-2~all~insert_cask~default-1-null.142^v93^chatsearchT3_1"}}] [.reference_item style="max-width: 33.333333333333336%"] - *2* [VBA 收集 - 遍历文件夹文件所有 Excel 文件](https://blog.csdn.net/jx520/article/details/123764076)[target="_blank" data-report-click={"spm":"1018.2226.3001.9630","extra":{"utm_source":"vip_chatgpt_common_search_pc_result","utm_medium":"distribute.pc_search_result.none-task-cask-2~all~insert_cask~default-1-null.142^v93^chatsearchT3_1"}}] [.reference_item style="max-width: 33.333333333333336%"] - *3* [VBA批量遍历更改文件名.xlsm](https://download.csdn.net/download/baidu_19965419/12114230)[target="_blank" data-report-click={"spm":"1018.2226.3001.9630","extra":{"utm_source":"vip_chatgpt_common_search_pc_result","utm_medium":"distribute.pc_search_result.none-task-cask-2~all~insert_cask~default-1-null.142^v93^chatsearchT3_1"}}] [.reference_item style="max-width: 33.333333333333336%"] [ .reference_list ]

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 12
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值