VBA文件及文件夹操作

经典word整理文档，仅参考，双击此处可删除页眉页脚。本资料属于网络整理，如有侵权，请联系删除，谢谢！onerrorresumenext下测试，在：\下新建文件夹，命名为folder方法1MkDir：\folder"FileCopy：\folder\a.xls",\folder1\c.xls"复制folder中所有文件到folder1Setrrr=CreateObject("Scripting.FileSystemObject")Setr=\folder1")ForEachiInr.Filesexcel工作表，要是手工一个一个的获得文件名的话，那我可是要忙十天半月哦。于是想到昨论坛就是vbaexcelexcelvba给你工作提高效率的结果！exclevba自动获取同一文件夹下所有工作表的名称红色代码：按，打开VBA编辑器，插入一个模块，把下面的代码贴进去，按F5执行现在获得的可是带路径的工作表名，去掉前的路径可用以下方法；=RIGHT(A1,LEN(A1)-FIND("#",SUBSTITUTE(A1,"\","#",LEN(A1)-LEN(SUBSTITUTE(A1,"\",)))))最后用常规的方法往下拖，就完成了笔者所需的工作表名。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")'系统暂停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\"注意路径，换成你实际的路径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可以对电脑中的文件及文件夹做一些常用的操作。包括复制、重命名、删除等，其中一些简单的示例总结如下。希望对一些经常需要批量处理文件的朋友有所帮助，也希望感兴趣的朋2，新建2个文件命名为a.xls和b.xlsFileCopy：\folder\a.xls",\folder1\c.xls"4,复制folder中所有文件到folder1VBADir函数遍历文件夹下的所有文件2010-05-2630Dimwjm1、Sub示例_1_12()：宏程序的开始语句。宏名为示例_1_12。2、Dimwjm：变量wjm声明为可变型数据类型。3、wjm=：\WINDOWS\WIN.ini")：如果该文件存在则返回“”(在C\Windows文件夹中)，把返回的文件名赋给变量wjm。如果该文件不存在则4、wjm=：\WINDOWS\*.ini")：*.ini按条件第一个找到的文件名。若第二次调用Dir函数，但不带任何参数，则函数将返回同一目录下的下一个*.ini文件。返回一个字符串String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。Dir[(pathname[,attributes])]目录或文件夹、以及驱动器。如果没有找到pathname，则会返回零长度字符串("")。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代码来进行。代码运行后，首先弹出一个浏览文件夹对话框，然后新建一个工作簿，并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。方法如下：1.按，打开VBA码粘贴到右侧的代码窗口中：OptionExplicitDimFSOAsObject,myFileAsObjectDimmyResultsAsDimlAsLong'显示打开文件夹对话框'获取文件夹中的所有文件列表varFileList=fcnGetFileList(strFolder)IfNotIsArray(varFileList)ThenMsgBox未找到文件",vbInformationExitSubmyResults(0,1)=大小（字节）"myResults(0,2)=创建时间"myResults(0,3)=修改时间"myResults(0,4)=访问时间"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'新建一个工作簿Application.SheetsInNewWorkbook=1EndIfRange(.Cells(1,1),.Cells(UBound(varData,1)+1,UBound(varData,2)+1))2.关闭VBA编辑器，回到Excel工作表中，按Alt+F8，打开“宏”对话框，选择“GetFileList?已经解决了，新的代码---------------------------------------------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'【自定义函数】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中测试通过ExcelVBA选择目标文件夹方法2009-04-1349用9.MsgBox.SelectedItems(1)SubSample2()SetShell=CreateObject("Shell.Application")SetmyPath=Shell.BrowseForFolder(&O0,"请选择文件夹",&H1+&H10,DeclareFunctionSHGetPathFromIDListLib"shell32.dll"Alias"SHGetPathFromIDListA"_(ByValpidlAsLong,ByValpszPathAsString)AsLongDeclareFunctionSHBrowseForFolderLib"shell32.dll"Alias"SHBrowseForFolderA"_pidlRootAsLongiImageAsLongbuf=GetFolder("请选择文件夹")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'【自定义函数】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中测试通过11.CreateObject("scripting.filesystemobject").getfolder(strpathname).Delete利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。包括复制、重命名、删除等，其中一些简单的示例总结如下。希望对一些经常需要批量处理文件的朋友有所帮助，也希望感兴趣的朋友多多指教！以下代码建议在onerrorresumenext下测试1，在：\下新建文件夹，命名为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：\folder\a.xls",：\folder1\c.xls"4,复制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”)但是如果文件夹已经存在了会出错那怎么判断一个文件夹存不存在？Dimfsofso.CreateFolder(foldername)endifDimfsofso.CreateFolder(foldername)endif14.参数folderspec必选项。文件夹名称，表示要确定是否存在的文件夹。如果该文件夹不15.利用excel中的vba括复制、重命名、删除等，其中一些简单的示例总结如下。希望对一些经常需要批量处理文件的朋友有所帮助，也希望感兴趣的朋友多多指教！以下代码建议在onerrorresumenext下测试1，在\下新建文件夹，命名为folderSetabc=Create