批量输出文件夹内所有文件名和文件——vba实现

yngsqq

于 2024-07-30 20:22:50 发布

阅读量158

点赞数 5

分类专栏：函数（VBA）文章标签： java 开发语言

本文链接：https://blog.csdn.net/yongshiqq/article/details/140792035

版权

函数（VBA）专栏收录该内容

42 篇文章 2 订阅

订阅专栏

导出一个文件夹下所有文件名，可用vba插件实现，如图

如下图，已在桌面生成一个txt文本，但此方法只可输出一级目录下的文件，若输出所有文件，则需修改插件代码（若想导出硬盘下所有文件和文件夹，则需用递归算法，若需插件可联系本博。）

部分源代码如下：

Sub 输出文件夹所有文件名()
'yngqq443440204@2024年7月30日11:13:48
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder("D:\")
    Set fc = f.Files
    Dim arr() As String
  
    For Each f1 In fc
   
        s = s & f1.Name
        s = s & vbCrLf
        ReDim Preserve arr(i)
        arr(i) = f1.Name
        i = i + 1
    Next
    Select Case s
    Case ""
        MsgBox "没有文件"
    Case Else
        MsgBox s & vbCrLf & "qq4434440204", , "qq4434440204"
    End Select
    Dim path As String
    path = "C:\Users\Administrator\Desktop\1.txt"
    Open path For Output As #1
    For i = LBound(arr) To UBound(arr)
       Print #1, arr(i)
    Next i
    Close
    Stop
End Sub

Sub 批量提取文件夹名称和文件名称()
'yngqq443440204@2024年7月30日19:36:30
On Error Resume Next
Dim Pth As String

Dim a As Integer, zz As Integer

Dim Fso, Fld, FldName, ft, fff

Range("A:z").ClearContents

'清除A:D四列单元格内容

With Application.FileDialog(msoFileDialogFolderPicker)

'用户指定选择文件夹

.Title = "请选择指定文件夹"

If .Show Then Pth = .SelectedItems(1) Else Exit Sub

'未选择文件夹则退出程序, 否则将地址赋予变量Path

End With

Range("D1") = "文件夹地址"

Range("D2") = Pth

'将选择的文件夹地址放在D2单元格

Set Fso = CreateObject("Scripting.FileSystemObject")

Set Fld = Fso.GetFolder(Pth)

a = 1: f = 1: zz = 1: e = 1

Cells(a, 1) = Pth & "目录中文件夹名称(老)"

Cells(a, 2) = Pth & "目录中文件夹名称(新)"

Cells(1, 6) = Pth & "目录中子文件夹中文件内容"
Cells(1, 5) = "序号"
For Each FldName In Fld.subfolders '每个子文件夹
 
    a = a + 1
    f = f + 1
    Cells(a, 1) = FldName.Name '子文件夹的名字
     Cells(f, 6).Value = FldName.Name & "：子文件夹中的文件如下："
     Cells(f, 5).Value = a - 1
     f = f + 1
    For Each fft In FldName.Files '子文件夹下的文件
        f = f + 1
        Cells(f, 6).Value = fft.Name
        
    Next
    f = f + 1
Next
''''下面为文件名
Cells(e, 5).Value = Pth & "目录中文件名"
For Each ft In Fld.Files
    e = e + 1
    Cells(e, 5).Value = ft.Name
Next
MsgBox "已完成" & vbCrLf & "qq443440204", , "qq443440204"
End Sub