Excel使用Vba读取文件夹下所有文件.docx
- 文档编号:28309184
- 上传时间:2023-07-10
- 格式:DOCX
- 页数:7
- 大小:39.16KB
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
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel 使用 Vba 读取 文件夹 所有 文件