作者：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

【VBA研究】查找文件夹下面所有文件的名称