VBA文件及文件夾操作

經(jīng)典word整理文檔，僅參考，雙擊此處可刪除頁眉頁腳。本資料屬于網(wǎng)絡(luò)整理，如有侵權(quán)，請(qǐng)聯(lián)系刪除，謝謝！onerrorresumenext下測(cè)試，在：\下新建文件夾，命名為folder方法1MkDir：\folder"FileCopy：\folder\a.xls",\folder1\c.xls"復(fù)制folder中所有文件到folder1Setrrr=CreateObject("Scripting.FileSystemObject")Setr=\folder1")ForEachiInr.Filesexcel工作表，要是手工一個(gè)一個(gè)的獲得文件名的話，那我可是要忙十天半月哦。于是想到昨論壇就是vbaexcelexcelvba給你工作提高效率的結(jié)果！exclevba自動(dòng)獲取同一文件夾下所有工作表的名稱紅色代碼：按，打開VBA編輯器，插入一個(gè)模塊，把下面的代碼貼進(jìn)去，按F5執(zhí)行現(xiàn)在獲得的可是帶路徑的工作表名，去掉前的路徑可用以下方法；=RIGHT(A1,LEN(A1)-FIND("#",SUBSTITUTE(A1,"\","#",LEN(A1)-LEN(SUBSTITUTE(A1,"\",)))))最后用常規(guī)的方法往下拖，就完成了筆者所需的工作表名。outlook下VBA編程：把公用文件夾里的郵件附件拷貝出來保存在硬盤上BeforeDate=#10/1/2007#MyDir="E：\liuxc-work\oilloss\backupfrompublicfolder\"'choosethefolderlocationforsaveSetoNameSpace=oApp.GetNamespace("MAPI")SetoFolder=oNameSpace.PickFolderForEachoMailItemInoFolder.ItemsMsgBoxoMailItem.Attachments.Item(i).DisplayName&"wassavedas"&IfMyY>10ThenGoToLoopEndLoopEnd：3.方法一DimAccessDataAsObjectApplication.WaitNow()+TimeValue("00：0002")'系統(tǒng)暫停2秒以等待data.mdb建立成功cnnaccess.Open"DataSource="&Stpath&";JetOLEDB：DatabasePassword="&""MyMainFile=ThisWorkbook.NameDimCurFileAsStringmyFile=Application.GetOpenFilename("(*.xls),*.xls)",,"PleaseSelect&.DoCmd.TransferSpreadsheetacLink,8,TableName,LinkFile,True,"Aging&.DoCmd.TransferSpreadsheetacImport,8,TableName,LinkFile,True,""方法二SubFolder2Access()DimdbAsDAO.DatabaseDimwsAsDAO.WorkspaceSetws=DBEngine.Workspaces(0)Set=：db.Closes.LookIn=：\CustomersDataBase\Test\"注意路徑，換成你實(shí)際的路徑s.Filename="*.*"搜索所有文件Fori=1Tos.FoundFiles.CountFullName1=Right(s.FoundFiles(i),Len(s.FoundFiles(i))-Len("C：\CustomersDataBase\Test\"))("C.DoCmd.TransferSpreadsheetacImport,8,"DSEM-MovingPlan",myFile,True,""Next4.利用excel中的vba可以對(duì)電腦中的文件及文件夾做一些常用的操作。包括復(fù)制、重命名、刪除等，其中一些簡(jiǎn)單的示例總結(jié)如下。希望對(duì)一些經(jīng)常需要批量處理文件的朋友有所幫助，也希望感興趣的朋2，新建2個(gè)文件命名為a.xls和b.xlsFileCopy：\folder\a.xls",\folder1\c.xls"4,復(fù)制folder中所有文件到folder1VBADir函數(shù)遍歷文件夾下的所有文件2010-05-2630Dimwjm1、Sub示例_1_12()：宏程序的開始語句。宏名為示例_1_12。2、Dimwjm：變量wjm聲明為可變型數(shù)據(jù)類型。3、wjm=：\WINDOWS\WIN.ini")：如果該文件存在則返回“”(在C\Windows文件夾中)，把返回的文件名賦給變量wjm。如果該文件不存在則4、wjm=：\WINDOWS\*.ini")：*.ini按條件第一個(gè)找到的文件名。若第二次調(diào)用Dir函數(shù)，但不帶任何參數(shù)，則函數(shù)將返回同一目錄下的下一個(gè)*.ini文件。返回一個(gè)字符串String，用以表示一個(gè)文件名、目錄名或文件夾名稱，它必須與指定的模式或文件屬性、或磁盤卷標(biāo)相匹配。Dir[(pathname[,attributes])]目錄或文件夾、以及驅(qū)動(dòng)器。如果沒有找到pathname，則會(huì)返回零長(zhǎng)度字符串("")。attributesSub查找文件夾下子文件夾及其大小()DimtheDirAsStringpt=theDirlistPaththeDir’用于列出子目錄和文件Cells(row,1)=s'文件的名稱Cells(row,1).Font.Color=RGB(256,12,213)Cells(row,1).Font.Bold=Tures=DirNext用如果我們要在Excel的VBA代碼來進(jìn)行。代碼運(yùn)行后，首先彈出一個(gè)瀏覽文件夾對(duì)話框，然后新建一個(gè)工作簿，并在工作表的A至F列分別列出選定文件夾中的所有文件的文件名、文件大小、創(chuàng)建時(shí)間、修改時(shí)間、訪問時(shí)間及完整路徑。方法如下：1.按，打開VBA碼粘貼到右側(cè)的代碼窗口中：OptionExplicitDimFSOAsObject,myFileAsObjectDimmyResultsAsDimlAsLong'顯示打開文件夾對(duì)話框'獲取文件夾中的所有文件列表varFileList=fcnGetFileList(strFolder)IfNotIsArray(varFileList)ThenMsgBox未找到文件",vbInformationExitSubmyResults(0,1)=大?。ㄗ止?jié)）"myResults(0,2)=創(chuàng)建時(shí)間"myResults(0,3)=修改時(shí)間"myResults(0,4)=訪問時(shí)間"myResults(0,5)=完整路徑"fcnDumpToWorksheetmyResultsSetmyFile=NothingPrivateFunctionfcnGetFileList(ByValstrPathAsString,OptionalstrFilterAsCase"\","/"strPath=Left$(strPath,Len(strPath)-1)f=Dir$(strPath&"\"&strFilter)ReDimPreserveFileList(i)AsStringFileList(i)=ffcnGetFileList=FileListPrivateSubfcnDumpToWorksheet(varDataAsVariant,OptionalmyShAsDimshAsWorksheet,wbAsWorkbookDimmyColumnHeaders()AsStringDimlAsLong,NoOfRowsAsLongIfmyShIsNothingThen'新建一個(gè)工作簿Application.SheetsInNewWorkbook=1EndIfRange(.Cells(1,1),.Cells(UBound(varData,1)+1,UBound(varData,2)+1))2.關(guān)閉VBA編輯器，回到Excel工作表中，按Alt+F8，打開“宏”對(duì)話框，選擇“GetFileList?已經(jīng)解決了，新的代碼---------------------------------------------Subsearchfiles()WithApplication.FileSearch.NewSearch.Filename="*.xls".SearchSubFolders=True.FileType=msoFileTypeAllFilesIf.Execute()>0ThenFori=1To.FoundFiles.CountWorksheets("sheet3").Cells(i,2).Value=.FoundFiles(i)Dimfs,f,s'【類型聲明】hWndOwnerpIDLRootlParam'【自定義函數(shù)】PublicFunctionGetFolder_API(sTitleAsString,OptionalvFlagsAsVariant)AsStringDimBInfoAsBROWSEINFOIfIsMissing(vFlags)ThenvFlags=BIF_USENEWUICallOleInitialize(ByVal0&)WithBInfo.lpszTitle=lstrcat(sTitle,"").ulFlags=vFlags'【使用方法】SubTest()MsgBoxGetFolder_API("選擇文件夾")2、使用Shell.Application方法SubGetFloder_Shell()SetobjShell=Nothing3、使用FileDialog方法SubGetFloder_FileDialog()DimfdAsFileDialog以上方法在WINXP+OFFICE2003中測(cè)試通過ExcelVBA選擇目標(biāo)文件夾方法2009-04-1349用9.MsgBox.SelectedItems(1)SubSample2()SetShell=CreateObject("Shell.Application")SetmyPath=Shell.BrowseForFolder(&O0,"請(qǐng)選擇文件夾",&H1+&H10,DeclareFunctionSHGetPathFromIDListLib"shell32.dll"Alias"SHGetPathFromIDListA"_(ByValpidlAsLong,ByValpszPathAsString)AsLongDeclareFunctionSHBrowseForFolderLib"shell32.dll"Alias"SHBrowseForFolderA"_pidlRootAsLongiImageAsLongbuf=GetFolder("請(qǐng)選擇文件夾")Ifbuf=""ThenExitSubMsgBoxbufFunctionGetFolder(OptionalMsg)AsStringDimbInfoAsBROWSEINFO,pPathAsStringDimRAsLong,XAsLong,posAsIntegerbInfo.pidlRoot=0&X=SHBrowseForFolder(bInfo)pPath=Space$(512)R=SHGetPathFromIDList(ByValX,ByValpPath)pos=InStr(pPath,Chr$(0))GetFolder=Left(pPath,pos-1)Else10.1、使用API方法'【類型聲明】hWndOwnerpIDLRootByValpszPathAsString)AsLongPrivateDeclareSubOleUninitializeLib"ole32"()PrivateConstBIF_USENEWUI=&H40'【自定義函數(shù)】PublicFunctionGetFolder_API(sTitleAsString,OptionalvFlagsAsVariant).lpszTitle=lstrcat(sTitle,"").ulFlags=vFlags'【使用方法】SubTest()MsgBoxGetFolder_API("選擇文件夾")EndSub2、使用Shell.Application方法SubGetFloder_Shell()3、使用FileDialog方法SubGetFloder_FileDialog()DimfdAsFileDialogIffd.Show=-1ThenMsgBoxfd.SelectedItems(1)Setfd=Nothing以上方法在WINXP+OFFICE2003中測(cè)試通過11.CreateObject("scripting.filesystemobject").getfolder(strpathname).Delete利用excel中的vba可以對(duì)電腦中的文件及文件夾做一些常用的操作。包括復(fù)制、重命名、刪除等，其中一些簡(jiǎn)單的示例總結(jié)如下。希望對(duì)一些經(jīng)常需要批量處理文件的朋友有所幫助，也希望感興趣的朋友多多指教！以下代碼建議在onerrorresumenext下測(cè)試1，在：\下新建文件夾，命名為folder方法1：MkDir"D：\folder"方法2：Setabc=CreateObject("Scripting.FileSystemObject")abc.CreateFolder("D：\folder")2，新建2個(gè)文件命名為a.xls和b.xlsWorkbooks.AddActiveWorkbook.SaveAsFilename：="D：\folder\a.xls"ActiveWorkbook.SaveAsFilename：="D：\folder\b.xls"3,創(chuàng)建新文件夾folder1并把a(bǔ).xls復(fù)制到新文件夾重新命名為c.xlsMkDir"D：\folder1"FileCopy：\folder\a.xls",：\folder1\c.xls"4,復(fù)制folder中所有文件到folder1Setqqq=CreateObject("Scripting.FileSystemObject")qqq.CopyFolder"D：\folder","D：\folder1"Then...If\folder1\d.xls)=TrueThen...7,打開folder1中所有文件Setrrr=CreateObject("Scripting.FileSystemObject")Setr=\folder1")ForEachiInr.FilesWorkbooks.OpenFilename：=("d：\folder1\"+i.Name+"")Next9,刪除文件夾folderSetaaa=CreateObject("Scripting.FileSystemObject")aaa.DeleteFolder：\folder"Setfso=CreatObject(“Scripting.FileSystemObject”)但是如果文件夾已經(jīng)存在了會(huì)出錯(cuò)那怎么判斷一個(gè)文件夾存不存在？Dimfsofso.CreateFolder(foldername)endifDimfsofso.CreateFolder(foldername)endif14.參數(shù)folderspec必選項(xiàng)。文件夾名稱，表示要確定是否存在的文件夾。如果該文件夾不15.利用excel中的vba括復(fù)制、重命名、刪除等，其中一些簡(jiǎn)單的示例總結(jié)如下。希望對(duì)一些經(jīng)常需要批量處理文件的朋友有所幫助，也希望感興趣的朋友多多指教！以下代碼建議在onerrorresumenext下測(cè)試1，在\下新建文件夾，命名為folderSetabc=Create