最近使用VBA编程,要用到一个功能,使得Excel能够读取指定文件夹下的所有文件名称。使用的是Excel2022版本,但是在Excel2022版本中能够使用的FileSearch在Excel2022版中会出错,因此不得不另找其它方法,下面介绍三种方法,在Excel单元格中显示特定目录下的文件名称〔文件大小,日期时间等〕,也可以自行修改符合自己的使用
要求
对教师党员的评价套管和固井爆破片与爆破装置仓库管理基本要求三甲医院都需要复审吗
。在Excel2022和Excel2022版本中均测试过可行。我工作中使用繁体,第三种方法使用的是繁体,所以在简体系统下会乱码,这个不会阻碍程序运行,gongxi1是我设置的一个窗体,可忽略。第三种不仅仅能导入特定文件下的所有文件,也可以导入文件夹下的文件夹文件。第一种:Subtestit()DimkAsVariantDimmAsVariantm=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 EndSubFunctionFileList(fldrAsString,OptionalfltrAsString="*.*")AsVariant DimsTempAsString,sHldrAsString IfRight$(fldr,1)<>""Thenfldr=fldr&"" sTemp=Dir(fldr&fltr) IfsTemp=""Then FileList=Split("Nofilesfound","|")'确保返回数组 ExitFunction EndIf Do sHldr=Dir IfsHldr=""ThenExitDo sTemp=sTemp&"|"&sHldr Loop FileList=Split(sTemp,"|")EndFunction-----------------------------------------------------------------------------第二种:OptionExplicitSubListFiles() DimDirectoryAsString DimrAsLong DimfAsString DimFileSizeAsDouble WithApplication.FileDialog(msoFileDialogFolderPicker) .InitialFileName=Application.DefaultFilePath&"" .Title="Selectalocationcontainingthefilesyouwanttolist." .Show If.SelectedItems.Count=0Then ExitSub Else Directory=.SelectedItems(1)&"" EndIf EndWith r=1' 插入
表
关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf
头 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 LoopEndSub-----------------------------------------------------------------------------第三种:OptionExplicitSubGetAllFiles() 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.ShowEndSubPublicSubRecursiveDir(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) NextiEndSub