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,創(chuàng)立新文獻夾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一次性獲取文獻夾下的全部文獻名的辦法小生今天上網(wǎng)下載了一種財務慣用報表的文獻包，里面有幾百個excel工作表，要是手工一種一種的獲得文獻名的話，那我可是要忙十天半月哦。于是想到昨論壇就是vba論壇，昨不充足運用excel本身的高級應用呀，呵呵，實現(xiàn)的代碼以下，把工作量幾天的任務可是一下子就完畢了，這就是excelvba給你工作提高效率的成果！exclevba自動獲取同一文獻夾下全部工作表的名稱紅色代碼：按Alt+F11，打開VBA編輯器，插入一種模塊，把下面的代碼貼進去，按F5執(zhí)行Subt()DimsAsFileSearch'定義一種文獻搜索對象Sets=Application.FileSearchs.LookIn="c：\"'注意途徑，換成你實際的途徑s.Filename="*.*"'搜索全部文獻s.Execute'執(zhí)行搜索Cells.Delete'表格清空Fori=1Tos.FoundFiles.CountCells(i,1)=s.FoundFiles(i)'每一行第一列填寫一種文獻名NextEndSub現(xiàn)在獲得的可是帶途徑的工作表名，去掉前的途徑可用下列辦法；=RIGHT(A1,LEN(A1)-FIND("#",SUBSTITUTE(A1,"\","#",LEN(A1)-LEN(SUBSTITUTE(A1,"\",)))))最后用常規(guī)的辦法往下拖，就完畢了筆者所需的工作表名。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數(shù)據(jù)庫中-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'創(chuàng)立表格Setcnnaccess=CreateObject("Adodb.Connection")SetrstAnswers=CreateObject("Adodb.Recordset")cnnaccess.Provider="Microsoft.Jet.OLEDB.4.0"Application.WaitNow()+TimeValue("00：00：02")'系統(tǒng)暫停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'執(zhí)行搜索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能夠?qū)﹄娔X中的文獻及文獻夾做某些慣用的操作。涉及復制、重命名、刪除等，其中某些簡樸的示例總結(jié)以下。但愿對某些經(jīng)常需要批量解決文獻的朋友有所協(xié)助，也但愿感愛好的朋友多多指教！下列代碼建議在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,創(chuàng)立新文獻夾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函數(shù)遍歷文獻夾下的全部文獻-05-2617：30VBADir函數(shù)第1.12例Dir函數(shù)一、題目：規(guī)定編寫一段代碼，運用Dir函數(shù)返回一種文獻夾的文獻列表。二、代碼：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聲明為可變型數(shù)據(jù)類型。3、wjm=Dir("C：\WINDOWS\WIN.ini")：如果該文獻存在則返回“WIN.INI”(在C：\Windows文獻夾中)，把返回的文獻名賦給變量wjm。如果該文獻不存在則wjm=””。4、wjm=Dir("C：\WINDOWS\*.ini")：返回帶指定擴展名的文獻名。如果超出一種*.ini文獻存在，函數(shù)將返回按條件第一種找到的文獻名。5、wjm=Dir：若第二次調(diào)用Dir函數(shù)，但不帶任何參數(shù)，則函數(shù)將返回同一目錄下的下一種*.ini文獻。Dir函數(shù)返回一種字符串String，用以表達一種文獻名、目錄名或文獻夾名稱，它必須與指定的模式或文獻屬性、或磁盤卷標相匹配。Dir[(pathname[,attributes])]Dir函數(shù)的語法含有下列幾個部分：pathname可選參數(shù)。用來指定文獻名的字符串體現(xiàn)式，可能包含目錄或文獻夾、以及驅(qū)動器。如果沒有找到pathname，則會返回零長度字符串("")。attributes可選參數(shù)。常數(shù)或數(shù)值體現(xiàn)式，其總和用來指定文獻屬性。如果省略，則會返回匹配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列分別列出選定文獻夾中的全部文獻的文獻名、文獻大小、創(chuàng)立時間、修改時間、訪問時間及完整途徑。辦法以下：1.按Alt+F11，打開VBA編輯器，單擊菜單“插入→模塊”，將下面的代碼粘貼到右側(cè)的代碼窗口中：OptionExplicitSubGetFileList()DimstrFolderAsStringDimvarFileListAsVariantDimFSOAsObject,myFileAsObjectDimmyResultsAsVariantDimlAsLong'顯示打開文獻夾對話框WithApplication.FileDialog(msoFileDialogFolderPicker).ShowIf.SelectedItems.Count=0ThenExitSub'未選擇文獻夾strFolder=.SelectedItems(1)EndWith'獲取文獻夾中的全部文獻列表varFileList=fcnGetFileList(strFolder)IfNotIsArray(varFileList)ThenMsgBox"未找到文獻",vbInformationExitSubEndIf'獲取文獻的具體信息，并放到數(shù)組中ReDimmyResults(0ToUBound(varFileList)+1,0To5)myResults(0,0)="文獻名"myResults(0,1)="大?。ㄗ止?jié)）"myResults(0,2)="創(chuàng)立時間"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'如果文獻夾中包含文獻返回一種二維數(shù)組，否則返回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.關(guān)閉VBA編輯器，回到Excel工作表中，按Alt+F8，打開“宏”對話框，選擇“GetFileList”，單擊“運行”按鈕。VBA中如何取文獻的最后修改時間?已經(jīng)解決了，新的代碼---------------------------------------------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代碼調(diào)用瀏覽文獻夾對話框的幾個辦法-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'【自定義函數(shù)】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代碼調(diào)用瀏覽文獻夾對話框的幾個辦法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'【自定義函數(shù)】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'忽視錯誤,如果有錯誤發(fā)生就執(zhí)行下一語句Setfs=CreateObject("Scripting.FileSystemObject")Setf=fs.GetFolder("C：\DocumentsandSettings\winxp")f.DeleteEndSub簡樸就是CreateObject("scripting.filesystemobject").getfolder(strpathname).Delete運用excel中的vba能夠?qū)﹄娔X中的文獻及文獻夾做某些慣用的操作。涉及復制、重命名、刪除等，其中某些簡樸的示例總結(jié)以下。但愿對某些經(jīng)常需要批量解決文獻的朋友有所協(xié)助，也但愿感愛好的朋友多多指教！下列代碼建議在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,創(chuàng)立新文獻夾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”)提示這一句有錯......但是如果文獻夾已經(jīng)存在了會出錯那怎么判斷一種文獻夾存不存在？DimfsoAsNewFileSystemObjectiffso.FolderExistsfolderNamethenmsgbox"文獻夾已存在！"elsefso.CreateFolder(foldername)endifFileSystemObj