VBA文件及文件夹操作

VBA文献及文献夹操作VBA操作文献及文献夹onerrorresumenext下测试A，在D：\下新建文献夹，命名为folder办法1：MkDir"D：\folder"办法2：Setabc=CreateObject("Scripting.FileSystemObject")abc.CreateFolder("D：\folder")B，新建2个文献命名为a.xls和b.xlsWorkbooks.AddActiveWorkbook.SaveAsFilename：="D：\folder\a.xls"ActiveWorkbook.SaveAsFilename：="D：\folder\b.xls"C,创立新文献夹folder1并把a.xls复制到新文献夹重新命名为c.xlsMkDir"D：\folder1"FileCopy"D：\folder\a.xls","D：\folder1\c.xls"D,复制folder中全部文献到folder1Setqqq=CreateObject("Scripting.FileSystemObject")qqq.CopyFolder"D：\folder","D：\folder1"D,重命名a.xls为d.xlsname"d：\folder1\a.xls"as"d：\folder1\d.xls"E,判断文献及文献夹与否存在Setyyy=CreateObject("Scripting.FileSystemObject")Ifyyy.FolderExists("D：\folder1)=TrueThen...Ifyyy.FileExists("D：\folder1\d.xls)=TrueThen...F,打开folder1中全部文献Setrrr=CreateObject("Scripting.FileSystemObject")Setr=rrr.GetFolder("d：\folder1")ForEachiInr.FilesWorkbooks.OpenFilename：=("d：\folder1\"+i.Name+"")NextG,删除文献c.xlskill"d：\folder1\c.xls"H,删除文献夹folderSetaaa=CreateObject("Scripting.FileSystemObject")aaa.DeleteFolder"d：\folder"8excelvba一次性获取文献夹下的全部文献名的办法小生今天上网下载了一种财务惯用报表的文献包，里面有几百个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编程：把公用文献夹里的邮件附件拷贝出来保存在硬盘上-06-1709：35SubSaveAttachments()DimoAppAsOutlook.ApplicationDimoNameSpaceAsNameSpaceDimoFolderAsMAPIFolderDimoMailItemAsObjectDimsMessageAsStringBeforeDate=#10/1/2007#'choosetheenddateofwantedMyDir="E：\liuxc-work\oilloss\backupfrompublicfolder\"'choosethefolderlocationforsaveSender="Hz121Supervisor"'caution,casesensitiveSendFile="HZ121-1_Daily.xls"MyY=0SetoApp=NewOutlook.ApplicationSetoNameSpace=oApp.GetNamespace("MAPI")SetoFolder=oNameSpace.PickFolderForEachoMailItemInoFolder.ItemsWithoMailItemMyT3=Left(CStr(oMailItem.CreationTime),10)IfCDate(oMailItem.CreationTime)>=BeforeDateThenIfoMailItem.SenderName=SenderThenIfoMailItem.Attachments.Count>0Then'protecterrorFori=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+".xls"oMailItem.Attachments.Item(i).SaveAsFileMyDir&MyT2MsgBoxoMailItem.Attachments.Item(i).DisplayName&"wassavedas"&oMailItem.Attachments.Item(i).FileNameEndIfNextiEndIfEndIfElseMyY=MyY+1IfMyY>10ThenGoToLoopEndEndIfEndWithNextoMailItemLoopEnd：'SetoMailItem=Nothing'SetoFolder=Nothing'SetoNameSpace=Nothing'SetoApp=NothingExcelVBA把选定文献夹中的工作簿导入到新建ACCESS数据库中-04-2422：33办法一SubCreate_AccessProject()DimAccessDataAsObjectSetAccessData=CreateObject("Access.Application")DimStpathAsStringStpath=ThisWorkbook.Path&"\DSEM-Stock-Allocation.mdb"'设定途径IfDir(Stpath,vbDirectory)="DSEM-Stock-Allocation.mdb"ThenKill(Stpath)EndIfAccessData.NewCurrentDatabaseStpathSetAccessData=Nothing'创立表格Setcnnaccess=CreateObject("Adodb.Connection")SetrstAnswers=CreateObject("Adodb.Recordset")cnnaccess.Provider="Microsoft.Jet.OLEDB.4.0"Application.WaitNow()+TimeValue("00：00：02")'系统暂停2秒,以等待data.mdb建立成功cnnaccess.Open"DataSource="&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")DoWhileCurFile<>vbNullStringSetobjAccess=CreateObject("Access.Application")LinkFile=DirLoc&CurFileTableName=Left(CurFile,Len(CurFile)-4)IfCurFile="HONHAI-VMIData1.xls"ThenWithobjAccess.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：\CustomersDataBase\DSEM-PO-Stock-Status.mdb",False,False,"")db.Execute("delete*from[DSEM-MovingPlan]")db.CloseSetdb=NothingDimmyFileAsStringDimsAsFileSearch'定义一种文献搜索对象Sets=Application.FileSearchs.LookIn="C：\CustomersDataBase\Test\"'注意途径，换成你实际的途径s.Filename="*.*"'搜索全部文献s.Execute'执行搜索Fori=1Tos.FoundFiles.CountFullName1=Right(s.FoundFiles(i),Len(s.FoundFiles(i))-Len("C：\CustomersDataBase\Test\"))Filename=Left(FullName1,Len(FullName1)-4)SetobjAccess=CreateObject("Access.Application")myFile="C：\CustomersDataBase\Test\"&Filename&".xls"WithobjAccess.OpenCurrentDatabase("C：\CustomersDataBase\DSEM-PO-Stock-Status.mdb").DoCmd.TransferSpreadsheetacImport,8,"DSEM-MovingPlan",myFile,True,""EndWithobjAccess.CloseCurrentDatabaseSetobjAccess=NothingNextEndSubvba操作文献及文献夹示例-08-2000：07vba操作文献及文献夹示例运用excel中的vba能够对电脑中的文献及文献夹做某些惯用的操作。涉及复制、重命名、删除等，其中某些简朴的示例总结以下。但愿对某些经常需要批量解决文献的朋友有所协助，也但愿感爱好的朋友多多指教！下列代码建议在onerrorresumenext下测试1，在D：\下新建文献夹，命名为folder办法1：MkDir"D：\folder"办法2：Setabc=CreateObject("Scripting.FileSystemObject")abc.CreateFolder("D：\folder")2，新建2个文献命名为a.xls和b.xlsWorkbooks.AddActiveWorkbook.SaveAsFilename：="D：\folder\a.xls"ActiveWorkbook.SaveAsFilename：="D：\folder\b.xls"3,创立新文献夹folder1并把a.xls复制到新文献夹重新命名为c.xlsMkDir"D：\folder1"FileCopy"D：\folder\a.xls","D：\folder1\c.xls"4,复制folder中全部文献到folder1Setqqq=CreateObject("Scripting.FileSystemObject")qqq.CopyFolder"D：\folder","D：\folder1"5,重命名a.xls为d.xlsname"d：\folder1\a.xls"as"d：\folder1\d.xls"6,判断文献及文献夹与否存在Setyyy=CreateObject("Scripting.FileSystemObject")Ifyyy.FolderExists("D：\folder1)=TrueThen...Ifyyy.FileExists("D：\folder1\d.xls)=TrueThen...7,打开folder1中全部文献Setrrr=CreateObject("Scripting.FileSystemObject")Setr=rrr.GetFolder("d：\folder1")ForEachiInr.FilesWorkbooks.OpenFilename：=("d：\folder1\"+i.Name+"")Next8,删除文献c.xlskill"d：\folder1\c.xls"9,删除文献夹folderSetaaa=CreateObject("Scripting.FileSystemObject")aaa.DeleteFolder"d：\folder"VBADir函数遍历文献夹下的全部文献-05-2617：30VBADir函数第1.12例Dir函数一、题目：规定编写一段代码，运用Dir函数返回一种文献夹的文献列表。二、代码：Sub示例_1_12()Dimwjmwjm=Dir("C：\WINDOWS\WIN.ini")MsgBoxwjmwjm=Dir("C：\WINDOWS\*.ini")wjm=DirEndSub三、代码详解1、Sub示例_1_12()：宏程序的开始语句。宏名为示例_1_12。2、Dimwjm：变量wjm声明为可变型数据类型。3、wjm=Dir("C：\WINDOWS\WIN.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用于同时显示目录文献夹和文献列表-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)'获取第一种文献DoWhiles<>""row=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()查找文献夹下子文献夹及其大小EndSub用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=""ThenstrFilter="*.*"SelectCaseRight$(strPath,1)Case"\","/"strPath=Left$(strPath,Len(strPath)-1)EndSelectReDimPreserveFileList(0)f=Dir$(strPath&"\"&strFilter)DoWhileLen(f)>0ReDimPreserveFileList(i)AsStringFileList(i)=fi=i+1f=Dir$()LoopIfFileList(0)<>EmptyThenfcnGetFileList=FileListElsefcnGetFileList=FalseEndIfEndFunctionPrivateSubfcnDumpToWorksheet(varDataAsVariant,OptionalmyShAsWorksheet)DimiSheetsInNewAsIntegerDimshAsWorksheet,wbAsWorkbookDimmyColumnHeaders()AsStringDimlAsLong,NoOfRowsAsLongIfmyShIsNothingThen'新建一种工作簿iSheetsInNew=Application.SheetsInNewWorkbookApplication.SheetsInNewWorkbook=1Setwb=Application.Workbooks.AddApplication.SheetsInNewWorkbook=iSheetsInNewSetsh=wb.Sheets(1)ElseSetmySh=shEndIfWithshRange(.Cells(1,1),.Cells(UBound(varData,1)+1,UBound(varData,2)+1))=varData.UsedRange.Columns.AutoFitEndWithSetsh=NothingSetwb=NothingEndSub2.关闭VBA编辑器，回到Excel工作表中，按Alt+F8，打开“宏”对话框，选择“GetFileList”，单击“运行”按钮。VBA中如何取文献的最后修改时间?已经解决了，新的代码---------------------------------------------Subsearchfiles()WithApplication.FileSearch.NewSearch.LookIn="D：\ttt".Filename="*.xls".SearchSubFolders=True.FileType=msoFileTypeAllFilesIf.Execute()>0ThenFori=1To.FoundFiles.CountWorksheets("sheet3").Cells(i,2).Value=.FoundFiles(i)Dimfs,f,sSetfs=CreateObject("Scripting.FileSystemObject")Setf=fs.GetFile(.FoundFiles(i))s="Created："&f.DateCreatedWorksheets("sheet3").Cells(i,3).Value=sSetf=NothingSetfs=NothingNextiElseMsgBox"nofilefound."EndIfEndWithEndSubVBA代码调用浏览文献夹对话框的几个办法-05-2515：241、使用API办法'【类型声明】PrivateTypeBROWSEINFOhWndOwnerAsLongpIDLRootAsLongpszDisplayNameAsLonglpszTitleAsLongulFlagsAsLonglpfnCallbackAsLonglParamAsLongiImageAsLongEndType'【API声明】PrivateDeclareFunctionSHGetPathFromIDListLib"shell32.dll"_Alias"SHGetPathFromIDListA"(ByValpidlAsLong,_ByValpszPathAsString)AsLongPrivateDeclareFunctionSHBrowseForFolderLib"shell32.dll"_Alias"SHBrowseForFolderA"(lpBrowseInfoAsBROWSEINFO)AsLongPrivateDeclareFunctionlstrcatLib"kernel32"_Alias"lstrcatA"(ByVallpString1AsString,_ByVallpString2AsString)AsLongPrivateDeclareFunctionOleInitializeLib"ole32.dll"_(lpAsAny)AsLongPrivateDeclareSubOleUninitializeLib"ole32"()PrivateConstBIF_USENEWUI=&H40PrivateConstMAX_PATH=260'【自定义函数】PublicFunctionGetFolder_API(sTitleAsString,OptionalvFlagsAsVariant)AsStringDimlpIDListAsLongDimsBufferAsStringDimBInfoAsBROWSEINFOIfIsMissing(vFlags)ThenvFlags=BIF_USENEWUICallOleInitialize(ByVal0&)WithBInfo.lpszTitle=lstrcat(sTitle,"").ulFlags=vFlagsEndWithlpIDList=SHBrowseForFolder(BInfo)If(lpIDList)ThensBuffer=Space(MAX_PATH)SHGetPathFromIDListlpIDList,sBuffersBuffer=Left(sBuffer,InStr(sBuffer,vbNullChar)-1)IfsBuffer<>""ThenGetFolder_API=sBufferEndIfCallOleUninitializeEndFunction'【使用办法】SubTest()MsgBoxGetFolder_API("选择文献夹")EndSub2、使用Shell.Application办法SubGetFloder_Shell()SetobjShell=CreateObject("Shell.Application")SetobjFolder=objShell.BrowseForFolder(0,"选择文献夹",0,0)IfNotobjFolderIsNothingThenMsgBoxobjFolder.self.pathEndIfSetobjFolder=NothingSetobjShell=NothingEndSub3、使用FileDialog办法SubGetFloder_FileDialog()DimfdAsFileDialogSetfd=Application.FileDialog(msoFileDialogFolderPicker)Iffd.Show=-1ThenMsgBoxfd.SelectedItems(1)Setfd=NothingEndSub以上办法在WINXP+OFFICE中测试通过ExcelVBA选择目的文献夹办法-04-1308：49用VBA选择目的文献夹几个实当代码：1.FileDialog属性SubSample1()WithApplication.FileDialog(msoFileDialogFolderPicker)If.Show=TrueThenMsgBox.SelectedItems(1)'txtFolder.Text=.SelectedItems(1)EndIfEndWithEndSub2.shell办法SubSample2()DimShell,myPathSetShell=CreateObject("Shell.Application")SetmyPath=Shell.BrowseForFolder(&O0,"请选择文献夹",&H1+&H10,"G：\")IfNotmyPathIsNothingThenMsgBoxmyPath.Items.Item.PathSetShell=NothingSetmyPath=NothingEndSub3.API办法DeclareFunctionSHGetPathFromIDListLib"shell32.dll"Alias"SHGetPathFromIDListA"_(ByValpidlAsLong,ByValpszPathAsString)AsLongDeclareFunctionSHBrowseForFolderLib"shell32.dll"Alias"SHBrowseForFolderA"_(lpBrowseInfoAsBROWSEINFO)AsLongDeclareFunctionGetDesktopWindowLib"user32"()AsLongPublicTypeBROWSEINFOhOwnerAsLongpidlRootAsLongpszDisplayNameAsStringlpszTitleAsStringulFlagsAsLonglpfnAsLonglParamAsLongiImageAsLongEndTypeSubSample3()DimbufAsStringbuf=GetFolder("请选择文献夹")Ifbuf=""ThenExitSubMsgBoxbufEndSubFunctionGetFolder(OptionalMsg)AsStringDimbInfoAsBROWSEINFO,pPathAsStringDimRAsLong,XAsLong,posAsIntegerbInfo.pidlRoot=0&bInfo.lpszTitle=MsgbInfo.ulFlags=&H1X=SHBrowseForFolder(bInfo)pPath=Space$(512)R=SHGetPathFromIDList(ByValX,ByValpPath)IfRThenpos=InStr(pPath,Chr$(0))GetFolder=Left(pPath,pos-1)ElseGetFolder=""EndIfEndFunctionVBA代码调用浏览文献夹对话框的几个办法1、使用API办法'【类型声明】PrivateTypeBROWSEINFOhWndOwnerAsLongpIDLRootAsLongpszDisplayNameAsLonglpszTitleAsLongulFlagsAsLonglpfnCallbackAsLonglParamAsLongiImageAsLongEndType'【API声明】PrivateDeclareFunctionSHGetPathFromIDListLib"shell32.dll"_Alias"SHGetPathFromIDListA"(ByValpidlAsLong,_ByValpszPathAsString)AsLongPrivateDeclareFunctionSHBrowseForFolderLib"shell32.dll"_Alias"SHBrowseForFolderA"(lpBrowseInfoAsBROWSEINFO)AsLongPrivateDeclareFunctionlstrcatLib"kernel32"_Alias"lstrcatA"(ByVallpString1AsString,_ByVallpString2AsString)AsLongPrivateDeclareFunctionOleInitializeLib"ole32.dll"_(lpAsAny)AsLongPrivateDeclareSubOleUninitializeLib"ole32"()PrivateConstBIF_USENEWUI=&H40PrivateConstMAX_PATH=260'【自定义函数】PublicFunctionGetFolder_API(sTitleAsString,OptionalvFlagsAsVariant)AsStringDimlpIDListAsLongDimsBufferAsStringDimBInfoAsBROWSEINFOIfIsMissing(vFlags)ThenvFlags=BIF_USENEWUICallOleInitialize(ByVal0&)WithBInfo.lpszTitle=lstrcat(sTitle,"").ulFlags=vFlagsEndWithlpIDList=SHBrowseForFolder(BInfo)If(lpIDList)ThensBuffer=Space(MAX_PATH)SHGetPathFromIDListlpIDList,sBuffersBuffer=Left(sBuffer,InStr(sBuffer,vbNullChar)-1)IfsBuffer<>""ThenGetFolder_API=sBufferEndIfCallOleUninitializeEndFunction'【使用办法】SubTest()MsgBoxGetFolder_API("选择文献夹")EndSub2、使用Shell.Application办法SubGetFloder_Shell()SetobjShell=CreateObject("Shell.Application")SetobjFolder=objShell.BrowseForFolder(0,"选择文献夹",0,0)IfNotobjFolderIsNothingThenMsgBoxobjFolder.self.pathEndIfSetobjFolder=NothingSetobjShell=NothingEndSub3、使用FileDialog办法SubGetFloder_FileDialog()DimfdAsFileDialogSetfd=Application.FileDialog(msoFileDialogFolderPicker)Iffd.Show=-1ThenMsgBoxfd.SelectedItems(1)Setfd=NothingEndSub以上办法在WINXP+OFFICE中测试通过VBA操作，删除，新建文献夹Subqd_name_del()'删除启动查找目录及文献'OnErrorResumeNext'忽视错误,如果有错误发生就执行下一语句Setfs=CreateObject("Scripting.FileSystemObject")Setf=fs.GetFolder("C：\DocumentsandSettings\winxp")f.DeleteEndSub简朴就是CreateObject("scripting.filesystemobject").getfolder(strpathname).Delete运用excel中的vba能够对电脑中的文献及文献夹做某些惯用的操作。涉及复制、重命名、删除等，其中某些简朴的示例总结以下。但愿对某些经常需要批量解决文献的朋友有所协助，也但愿感爱好的朋友多多指教！下列代码建议在onerrorresumenext下测试1，在D：\下新建文献夹，命名为folder办法1：MkDir"D：\folder"办法2：Setabc=CreateObject("Scripting.FileSystemObject")abc.CreateFolder("D：\folder")2，新建2个文献命名为a.xls和b.xlsWorkbooks.AddActiveWorkbook.SaveAsFilename：="D：\folder\a.xls"ActiveWorkbook.SaveAsFilename：="D：\folder\b.xls"3,创立新文献夹folder1并把a.xls复制到新文献夹重新命名为c.xlsMkDir"D：\folder1"FileCopy"D：\folder\a.xls","D：\folder1\c.xls"4,复制folder中全部文献到folder1Setqqq=CreateObject("Scripting.FileSystemObject")qqq.CopyFolder"D：\folder","D：\folder1"5,重命名a.xls为d.xlsname"d：\folder1\a.xls"as"d：\folder1\d.xls"6,判断文献及文献夹与否存在Setyyy=CreateObject("Scripting.FileSystemObject")Ifyyy.FolderExists("D：\folder1)=TrueThen...Ifyyy.FileExists("D：\folder1\d.xls)=TrueThen...7,打开folder1中全部文献Setrrr=CreateObject("Scripting.FileSystemObject")Setr=rrr.GetFolder("d：\folder1")ForEachiInr.FilesWorkbooks.OpenFilename：=("d：\folder1\"+i.Name+"")Next8,删除文献c.xlskill"d：\folder1\c.xls"9,删除文献夹folderSetaaa=CreateObject("Scripting.FileSystemObject")aaa.DeleteFolder"d：\folder"能够通过控件或者代码新建一种文献夹吗？Dimfso'AsObjectSetfso=CreatObject(“Scripting.FileSystemObject”)fso.CreateFolder(foldername)但是运行不了......Setfso=CreatObject(“Scripting.FileSystemObject”)提示这一句有错......但是如果文献夹已经存在了会出错那怎么判断一种文献夹存不存在？DimfsoAsNewFileSystemObjectiffso.FolderExistsfolderNamethenmsgbox"文献夹已存在！"elsefso.CreateFolder(foldername)endifFileSystemObj