Excel使用Vba读取文件夹下所有文件.docx

Excel使用Vba读取文件夹下所有文件.docx

《Excel使用Vba读取文件夹下所有文件.docx》由会员分享，可在线阅读，更多相关《Excel使用Vba读取文件夹下所有文件.docx（7页珍藏版）》请在冰豆网上搜索。

Excel使用Vba读取文件夹下所有文件

Excel使用Vba读取文件夹下所有文件

最近使用VBA编程，要用到一个功能，使得Excel能够读取指定文件夹下的所有文件名称。

使用的是Excel2010版本，但是在Excel2003版本中能够使用的FileSearch在Excel2010版中会出错，因此不得不另找其它方法，下面介绍三种方法，在Excel单元格中显示特定目录下的文件名称（文件大小，日期时间等），也可以自行修改符合自己的使用要求。

在Excel2010和Excel2003版本中均测试过可行。

我工作中使用繁体，第三种方法使用的是繁体，所以在简体系统下会乱码，这个不会妨碍程序运行，gongxi1是我设置的一个窗体，可忽略。

第三种不仅仅能导入特定文件下的所有文件，也可以导入文件夹下的文件夹文件。

第一种：

Subtestit（）

DimkAsVariant

DimmAsVariant

m=1

    myvar=FileList（"C:

\Users\ownding\SkyDrive\文档\工作事項"）

    Fori=LBound（myvar）ToUBound（myvar）

        Debug.Printmyvar（i）

    Next

    ForEachkInmyvar

       Sheets（"sheet1"）.Cells（m,1）=k

        m=m+1

    Nextk

EndSub

FunctionFileList（fldrAsString,OptionalfltrAsString="*.*"）AsVariant

    DimsTempAsString,sHldrAsString

    IfRight$（fldr,1）<>""Thenfldr=fldr&""

    sTemp=Dir（fldr&fltr）

    IfsTemp=""Then

        FileList=Split（"Nofilesfound","|"）'确保返回数组

' 插入表头

    Cells.ClearContents

    Cells（r,1）="Filesin"&Directory

    Cells（r,2）="Size"

    Cells（r,3）="Date/Time"

    Range（"A1:

C1"）.Font.Bold=True

'  获得第一个文件

    f=Dir（Directory,vbReadOnly+vbHidden+vbSystem）

    DoWhilef<>""

        r=r+1

        Cells（r,1）=f

        '调整 filesize>2gigabytes

        FileSize=FileLen（Directory&f）

        IfFileSize<0ThenFileSize=FileSize+4294967296#

        Cells（r,2）=FileSize

        Cells（r,3）=FileDateTime（Directory&f）

    '  获得下个文件

        f=Dir

    Loop

EndSub

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

第三种：

OptionExplicit

SubGetAllFiles（）

    DimDirectoryAsString

    DimAnsAsVariant

    DimusedtimeAsDouble

    Ans=MsgBox（"琌钡旧ゅン嘿匡拒隔畖",vbYesNo+vbQuestion）

    '矗ㄑ匡拒ゅンの钡旧ゅン匡兜

    IfAns=vbNoThen

    WithApplication.FileDialog（msoFileDialogFolderPicker）

        .InitialFileName=Application.DefaultFilePath&""

        .Title="叫匡拒ゅンЖ."

        .Show

        If.SelectedItems.Count=0Then

            ExitSub

        Else

            Directory=.SelectedItems

（1）&""

        EndIf

    EndWith

        Else

            Directory="\\189.3.3.3\ziliao\垂\だ摸诀计沮\etch-befor"

    EndIf

    Cells.ClearContents

    usedtime=Timer

    Application.ScreenUpdating=False

    CallRecursiveDir（Directory）

    '础

    ActiveSheet.ListObjects.AddxlSrcRange,_

Range（"A2"）.CurrentRegion,,xlYes

    Application.ScreenUpdating=True

    usedtime=Format（Timer-usedtime,"00.00"）

    gongxi1.TextBox2.Text=usedtime

    gongxi1.Show

EndSub

PublicSubRecursiveDir（ByValCurrDirAsString）

    DimDirs（）AsString

    DimNumDirsAsLong

    DimFilenameAsString

    DimPathAndNameAsString

    DimiAsLong

    DimFilesizeAsDouble

'  絋玂ゅン程\挡Ю

    IfRight（CurrDir,1）<>""ThenCurrDir=CurrDir&""

'  讽玡い材︽结

    Cells（2,1）="ゅン隔畖"

    Cells（2,2）="ゅン嘿"

    Cells（2,3）=""

    Cells（2,4）="ら戳/丁"

    Cells（2,5）="赣虫琌穨"

    Range（"A1:

E2"）.Font.Bold=True

'  莉眔ゅン

    OnErrorResumeNext

    Filename=Dir（CurrDir&"*.*",vbDirectory）

    DoWhileLen（Filename）<>0

      IfLeft（Filename,1）<>"."Then'讽玡dir

        PathAndName=CurrDir&Filename

        If（GetAttr（PathAndName）AndvbDirectory）=vbDirectoryThen

          '纗т隔畖

           ReDimPreserveDirs（0ToNumDirs）AsString

           Dirs（NumDirs）=PathAndName

           NumDirs=NumDirs+1

        Else

          '盢隔畖㎝嘿糶

          Cells（WorksheetFunction.CountA（Range（"A:

A"））+2,1）=CurrDir

          Cells（WorksheetFunction.CountA（Range（"B:

B"））+2,2）=Filename

          '秸俱ゅン

          Filesize=FileLen（PathAndName）

          IfFilesize<0ThenFilesize=Filesize+4294967296#

          Cells（WorksheetFunction.CountA（Range（"C:

C"））+2,3）=Filesize

          Cells（WorksheetFunction.CountA（Range（"D:

D"））+2,4）=FileDateTime（PathAndName）

        EndIf

    EndIf

        Filename=Dir（）

    Loop

    '矪瞶тゅン

    Fori=0ToNumDirs-1

        RecursiveDirDirs（i）

    Nexti

EndSub