VBA资料及文夹操作Word格式文档下载.docx

VBA资料及文夹操作Word格式文档下载.docx

《VBA资料及文夹操作Word格式文档下载.docx》由会员分享，可在线阅读，更多相关《VBA资料及文夹操作Word格式文档下载.docx（25页珍藏版）》请在冰豆网上搜索。

foldera.xls,D：

folder1c.xlsD,复制folder中所有文件到folder1Setqqq=CreateObject（Scripting.FileSystemObject）qqq.CopyFolderD：

folder,D：

folder1D,重命名a.xls为d.xlsnamed：

folder1a.xlsasd：

folder1d.xlsE,判断文件及文件夹是否存在Setyyy=CreateObject（Scripting.FileSystemObject）Ifyyy.FolderExists（D：

folder1）=TrueThen.Ifyyy.FileExists（D：

folder1d.xls）=TrueThen.F,打开folder1中所有文件Setrrr=CreateObject（Scripting.FileSystemObject）Setr=rrr.GetFolder（d：

folder1）ForEachiInr.FilesWorkbooks.OpenFilename：

=（d：

folder1+i.Name+）NextG,删除文件c.xlskilld：

folder1c.xlsH,删除文件夹folderSetaaa=CreateObject（Scripting.FileSystemObject）aaa.DeleteFolderd：

folder2.excelvba一次性获取文件夹下的所有文件名的方法一次性获取文件夹下的所有文件名的方法小生今天上网下载了一个财务常用报表的文件包，里面有几百个excel工作表，要是手工一个一个的获得文件名的话，那我可是要忙十天半月哦。

于是想到昨论坛就是vba论坛，昨不充分利用excel自身的高级应用呀，呵呵，实现的代码如下，把工作量几天的任务可是一下子就完成了，这就是excelvba给你工作提高效率的结果！

exclevba自动获取同一文件夹下所有工作表的名称红色代码：

按Alt+F11，打开VBA编辑器，插入一个模块，把下面的代码贴进去，按F5执行Subt（）DimsAsFileSearch定义一个文件搜索对象Sets=Application.FileSearchs.LookIn=c：

注意路径，换成你实际的路径s.Filename=*.*搜索所有文件s.Execute执行搜索Cells.Delete表格清空Fori=1Tos.FoundFiles.CountCells（i,1）=s.FoundFiles（i）每一行第一列填写一个文件名NextEndSub现在获得的可是带路径的工作表名，去掉前的路径可用以下方法；

=RIGHT（A1,LEN（A1）-FIND（#,SUBSTITUTE（A1,#,LEN（A1）-LEN（SUBSTITUTE（A1,）最后用常规的方法往下拖，就完成了笔者所需的工作表名。

outlook下VBA编程：

把公用文件夹里的邮件附件拷贝出来保存在硬盘上2009-06-1709：

35SubSaveAttachments（）DimoAppAsOutlook.ApplicationDimoNameSpaceAsNameSpaceDimoFolderAsMAPIFolderDimoMailItemAsObjectDimsMessageAsStringBeforeDate=#10/1/2007#choosetheenddateofwantedMyDir=E：

liuxc-workoillossbackupfrompublicfolderchoosethefolderlocationforsaveSender=Hz121Supervisorcaution,casesensitiveSendFile=HZ121-1_Daily.xlsMyY=0SetoApp=NewOutlook.ApplicationSetoNameSpace=oApp.GetNamespace（MAPI）SetoFolder=oNameSpace.PickFolderForEachoMailItemInoFolder.ItemsWithoMailItemMyT3=Left（CStr（oMailItem.CreationTime）,10）IfCDate（oMailItem.CreationTime）=BeforeDateThenIfoMailItem.SenderName=SenderThenIfoMailItem.Attachments.Count0ThenprotecterrorFori=1TooMailItem.Attachments.CountIfoMailItem.Attachments.Item（i）.FileName=SendFileThenMyT1=InStr（1,oMailItem.Attachments.Item（i）.FileName,.,1）MyT2=Left（oMailItem.Attachments.Item（i）.FileName,19）+-+MyT3+.xlsoMailItem.Attachments.Item（i）.SaveAsFileMyDir&

MyT2MsgBoxoMailItem.Attachments.Item（i）.DisplayName&

wassavedas&

oMailItem.Attachments.Item（i）.FileNameEndIfNextiEndIfEndIfElseMyY=MyY+1IfMyY10ThenGoToLoopEndEndIfEndWithNextoMailItemLoopEnd：

SetoMailItem=NothingSetoFolder=NothingSetoNameSpace=NothingSetoApp=Nothing3.ExcelVBA把选定文件夹中的工作簿导入到新建把选定文件夹中的工作簿导入到新建ACCESS数据库中数据库中2010-04-2422：

33方法一SubCreate_AccessProject（）DimAccessDataAsObjectSetAccessData=CreateObject（Access.Application）DimStpathAsStringStpath=ThisWorkbook.Path&

DSEM-Stock-Allocation.mdb设定路径IfDir（Stpath,vbDirectory）=DSEM-Stock-Allocation.mdbThenKill（Stpath）EndIfAccessData.NewCurrentDatabaseStpathSetAccessData=Nothing创建表格Setcnnaccess=CreateObject（Adodb.Connection）SetrstAnswers=CreateObject（Adodb.Recordset）cnnaccess.Provider=Microsoft.Jet.OLEDB.4.0Application.WaitNow（）+TimeValue（00：

00：

02）系统暂停2秒,以等待data.mdb建立成功cnnaccess.OpenDataSource=&

Stpath&

。

JetOLEDB：

DatabasePassword=&

strSQL=CreateTablemyData（last_datechar（8）rstAnswers.OpenstrSQL,cnnaccessSetrstAnswers=NothingSetcnnaccess=NothingMyMainFile=ThisWorkbook.NameDimCurFileAsStringApplication.DisplayAlerts=FalsemyFile=Application.GetOpenFilename（*.xls）,*.xls）,PleaseSelectFiles）IfmyFile=FalseThenExitSubDirLoc=CurDir（myFile）&

CurFile=Dir（DirLoc&

*.xls）DoWhileCurFilevbNullStringSetobjAccess=CreateObject（Access.Application）LinkFile=DirLoc&

CurFileTableName=Left（CurFile,Len（CurFile）-4）IfCurFile=HONHAI-VMIData1.xlsThenWithobjAccess.OpenCurrentDatabase（ThisWorkbook.Path&

DSEM-Stock-Allocation.mdb）.DoCmd.TransferSpreadsheetacLink,8,TableName,LinkFile,True,AgingReport$EndWithobjAccess.CloseCurrentDatabaseSetobjAccess=NothingCurFile=DirElseWithobjAccess.OpenCurrentDatabase（ThisWorkbook.Path&

DSEM-Stock-Allocation.mdb）.DoCmd.TransferSpreadsheetacImport,8,TableName,LinkFile,True,EndWithobjAccess.CloseCurrentDatabaseSetobjAccess=NothingCurFile=DirEndIfLoopEndSub方法二SubFolder2Access（）DimdbAsDAO.DatabaseDimwsAsDAO.WorkspaceSetws=DBEngine.Workspaces（0）Setdb=ws.OpenDatabase（C：

CustomersDataBaseDSEM-PO-Stock-Status.mdb,False,False,）db.Execute（delete*fromDSEM-MovingPlan）db.CloseSetdb=NothingDimmyFileAsStringDimsAsFileSearch定义一个文件搜索对象Sets=Application.FileSearchs.LookIn=C：

CustomersDataBaseTest注意路径，换成你实际的路径s.Filename=*.*搜索所有文件s.Execute执行搜索Fori=1Tos.FoundFiles.CountFullName1=Right（s.FoundFiles（i）,Len（s.FoundFiles（i）-Len（C：

CustomersDataBaseTest）Filename=Left（FullName1,Len（FullName1）-4）SetobjAccess=CreateObject（Access.Application）myFile=C：

CustomersDataBaseTest&

Filename&

.xlsWithobjAccess.OpenCurrentDatabase（C：

CustomersDataBaseDSEM-PO-Stock-Status.mdb）.DoCmd.TransferSpreadsheetacImport,8,DSEM-MovingPlan,myFile,True,EndWithobjAccess.CloseCurrentDatabaseSetobjAccess=NothingNextEndSub4.vba操作文件及文件夹示例操作文件及文件夹示例2009-08-2000：

07vba操作文件及文件夹示例利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。

包括复制、重命名、删除等，其中一些简单的示例总结如下。

希望对一些经常需要批量处理文件的朋友有所帮助，也希望感兴趣的朋友多多指教！

以下代码建议在onerrorresumenext下测试1，在D：

folder）2，新建2个文件命名为a.xls和b.xlsWorkbooks.AddActiveWorkbook.SaveAsFilename：

folderb.xls3,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xlsMkDirD：

folder1c.xls4,复制folder中所有文件到folder1Setqqq=CreateObject（Scripting.FileSystemObject）qqq.CopyFolderD：

folder15,重命名a.xls为d.xlsnamed：

folder1d.xls6,判断文件及文件夹是否存在Setyyy=CreateObject（Scripting.FileSystemObject）Ifyyy.FolderExists（D：

folder1d.xls）=TrueThen.7,打开folder1中所有文件Setrrr=CreateObject（Scripting.FileSystemObject）Setr=rrr.GetFolder（d：

folder1+i.Name+）Next8,删除文件c.xlskilld：

folder1c.xls9,删除文件夹folderSetaaa=CreateObject（Scripting.FileSystemObject）aaa.DeleteFolderd：

folderVBADir函数遍历文件夹下的所有文件2010-05-2617：

305.VBADir函数函数第1.12例Dir函数一、题目：

要求编写一段代码，运用Dir函数返回一个文件夹的文件列表。

二、代码：

Sub示例_1_12（）Dimwjmwjm=Dir（C：

WINDOWSWIN.ini）MsgBoxwjmwjm=Dir（C：

WINDOWS*.ini）wjm=DirEndSub三、代码详解1、Sub示例_1_12（）：

宏程序的开始语句。

宏名为示例_1_12。

2、Dimwjm：

变量wjm声明为可变型数据类型。

3、wjm=Dir（C：

WINDOWSWIN.ini）：

如果该文件存在则返回“WIN.INI”（在C：

Windows文件夹中），把返回的文件名赋给变量wjm。

如果该文件不存在则wjm=”。

4、wjm=Dir（C：

WINDOWS*.ini）：

返回带指定扩展名的文件名。

如果超过一个*.ini文件存在，函数将返回按条件第一个找到的文件名。

5、wjm=Dir：

若第二次调用Dir函数，但不带任何参数，则函数将返回同一目录下的下一个*.ini文件。

Dir函数返回一个字符串String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。

Dir（pathname,attributes）Dir函数的语法具有以下几个部分：

pathname可选参数。

用来指定文件名的字符串表达式，可能包含目录或文件夹、以及驱动器。

如果没有找到pathname，则会返回零长度字符串（）。

attributes可选参数。

常数或数值表达式，其总和用来指定文件属性。

如果省略，则会返回匹配pathname但不包含属性的文件。

EXCEL的VBA用于同时显示目录文件夹和文件列表2010-05-2218：

41”VBA工具中要引用microsoftsciptingruntimeDimptAsRangeSub查找文件夹下子文件夹及其大小（）DimtheDirAsStringSetpt=ActiveSheet.Range（a1）pt.Worksheet.Columns

（1）.ClearContents清除第一列theDir=Application.InputBox（输入指定文件夹的路径：

查看子文件夹及其大小）pt=theDir列出选取的目录名listPaththeDir用于列出子目录和文件pt.Worksheet.Columns（a：

b）.AutoFitEndSubSublistPath（strDirAsString）DimthePathAsStringDimstrSdirAsStringDimtheDirsAsScripting.FoldersDimtheDirAsScripting.FolderDimrowAsIntegerDimsAsStringDimmyFsoAsScripting.FileSystemObjectSetmyFso=NewScripting.FileSystemObjectIfRight（strDir,1）ThenstrDir=strDir&

thePath=thePath&

strDirrow=pt.row此段为获取此目录下的文件名s=Dir（thePath,7）获取第一个文件DoWhilesrow=row+1Cells（row,1）=s文件的名称Cells（row,1）.Font.Color=RGB（256,12,213）Cells（row,1）.Font.Bold=Tures=Dir下一个文件LoopSetpt=Cells（row,1）Setpt=pt.Offset（1,0）SettheDirs=myFso.getfolder（strDir）.subfoldersForEachtheDirIntheDirspt=theDir.Pathpt.Next=theDir.SizelistPaththeDir.PathNextSetmyFso=NothingEndSubPrivateSubCommandButton1_Click（）查找文件夹下子文件夹及其大小EndSub6.用用VBA获取文件夹中的文件列表获取文件夹中的文件列表如果我们要在Excel中获取某个文件夹中所有的文件列表，可以通过下面的VBA代码来进行。

代码运行后，首先弹出一个浏览文件夹对话框，然后新建一个工作簿，并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。

方法如下：

1.按Alt+F11，打开VBA编辑器，单击菜单“插入模块”，将下面的代码粘贴到右侧的代码窗口中：

OptionExplicitSubGetFileList（）DimstrFolderAsStringDimvarFileListAsVariantDimFSOAsObject,myFileAsObjectDimmyResultsAsVariantDimlAsLong显示打开文件夹对话框WithApplication.FileDialog（msoFileDialogFolderPicker）.ShowIf.SelectedItems.Count=0ThenExitSub未选择文件夹strFolder=.SelectedItems

（1）EndWith获取文件夹中的所有文件列表varFileList=fcnGetFileList（strFolder）IfNotIsArray（varFileList）ThenMsgBox未找到文件,vbInformationExitSubEndIf获取文件的详细信息，并放到数组中ReDimmyResults（0ToUBound（varFileList）+1,0To5）myResults（0,0）=文件名myResults（0,1）=大小（字节）myResults（0,2）=创建时间myResults（0,3）=修改时间myResults（0,4）=访问时间myResults（0,5）=完整路径SetFSO=CreateObject（Scripting.FileSystemObject）Forl=0ToUBound（varFileList）SetmyFile=FSO.GetFile（CStr（varFileList（l）myResults（l+1,0）=CStr（varFileList（l）myResults（l+1,1）=myFile.SizemyResults（l+1,2）=myFile.DateCreatedmyResults（l+1,3）=myFile.DateLastModifiedmyResults（l+1,4）=myFile.DateLastAccessedmyResults（l+1,5）=myFile.PathNextlfcnDumpToWorksheetmyResultsSetmyFile=NothingSetFSO=NothingEndSubPrivateFunctionfcnGetFileList（ByValstrPathAsString,OptionalstrFilterAsString）AsVariant如果文件夹中包含文件返回一个二维数组，否则返回FalseDimfAsStringDimiAsIntegerDimFileList（）AsStringIfstrFilter=ThenstrFilt