【VBA研究】查找目录以下全部文件的名称

作者：iamlaosong

目录里面保存有面单扫描的图像文件，文件名称为邮件号码。如今想收集这些邮件号码，由于量非常大，不可能一个一个的截取，仅仅能通过程序实现。假定，当前工作表B列里放的是存放这些图像文件的目录。以下的程序能够讲这些图像文件的邮件号码取出来：

Sub findname()
    Dim fs, f, f1, fc, mydir

    maxrow = Sheets("邮件号码").UsedRange.Rows.Count
    If maxrow >= 2 Then Sheets("邮件号码").Rows("2:" & maxrow).Delete Shift:=xlUp

    lineno = [B65536].End(xlUp).Row           '行数。目录数量
    row1 = 2
    For num = 6 To lineno    ' 从第6行開始存放目录名称
        mydir = ThisWorkbook.Path & "\" & Cells(num, 2)   '目录名称
        If Dir(mydir, vbDirectory) <> vbNullString Then
            'dir函数不仅能够推断目录是否存在，也能够推断文件是否存在
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFolder(mydir)    '在括号内输入你指定的目录
            Set fc = f.Files

            For Each f1 In fc
                Sheets("邮件号码").Cells(row1, 1) = Left(f1.name, 13)
                row1 = row1 + 1
            Next
            Cells(num, 3) = "成功"
        Else
            'MsgBox mydir & "目录不存在！

", vbOKOnly, "iamlaosong"
            Cells(num, 3) = "失败"
        End If
    Next num
    MsgBox "提取邮件号码数量：" & row1 - 2, vbOKOnly, "iamlaosong"
End Sub