VBA文件及文件夹操作

VBA文件及文件夹操作1. VBA操作文件及文件夹on error resume next下测试A，在D：下新建文件夹，命名为folder方法1：MkDir D：folder方法2：Set abc = CreateObject(Scripting.FileSystemObject)abc.CreateFolder (D：folder)B，新建2个文件命名为a.xls和b.xlsWorkbooks.AddActiveWorkbook.SaveAs Filename：=D：foldera.xlsActiveWorkbook.SaveAs Filename：=D：folderb.xlsC,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xlsMkDir D：folder1FileCopy D：foldera.xls, D：folder1c.xlsD,复制folder中所有文件到folder1Set qqq = CreateObject(Scripting.FileSystemObject)qqq.CopyFolder D：folder, D：folder1D,重命名a.xls为d.xlsname d：folder1a.xls as d：folder1d.xlsE,判断文件及文件夹是否存在Set yyy = CreateObject(Scripting.FileSystemObject)If yyy.FolderExists(D：folder1) = True Then .If yyy.FileExists(D：folder1d.xls) = True Then .F,打开folder1中所有文件Set rrr = CreateObject(Scripting.FileSystemObject)Set r = rrr.GetFolder(d：folder1)For Each i In r.FilesWorkbooks.Open Filename：=(d：folder1 + i.Name + )NextG,删除文件c.xlskill d：folder1c.xlsH,删除文件夹folderSet aaa = CreateObject(Scripting.FileSystemObject)aaa.DeleteFolder d：folder2. VBA Dir函数第 1.12例 Dir函数一、题目：要求编写一段代码，运用Dir函数返回一个文件夹的文件列表。二、代码：Sub 示例_1_12()Dim wjmwjm = Dir(C：WINDOWSWIN.ini)MsgBox wjmwjm = Dir(C：WINDOWS*.ini)wjm = DirEnd Sub三、代码详解1、Sub 示例_1_12()：宏程序的开始语句。宏名为示例_1_12。2、Dim wjm ：变量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-22 18：41”VBA工具中要引用microsoft scipting runtimeDim pt As RangeSub 查找文件夹下子文件夹及其大小()Dim theDir As StringSet pt = ActiveSheet.Range(a1)pt.Worksheet.Columns(1).ClearContents 清除第一列theDir = Application.InputBox (输入指定文件夹的路径：, 查看子文件夹及其大小)pt = theDir 列出选取的目录名listPath theDir 用于列出子目录和文件pt.Worksheet.Columns(a：b).AutoFitEnd SubSub listPath(strDir As String)Dim thePath As StringDim strSdir As StringDim theDirs As Scripting.FoldersDim theDir As Scripting.FolderDim row As IntegerDim s As StringDim myFso As Scripting.FileSystemObjectSet myFso = New Scripting.FileSystemObjectIf Right(strDir, 1) Then strDir = strDir & thePath = thePath & strDirrow = pt.row 此段为获取此目录下的文件名s = Dir(thePath, 7) 获取第一个文件Do While s row = row + 1Cells(row, 1) = s 文件的名称Cells(row, 1).Font.Color = RGB(256, 12, 213)Cells(row, 1).Font.Bold = Tures = Dir 下一个文件LoopSet pt = Cells(row, 1)Set pt = pt.Offset(1, 0)Set theDirs = myFso.getfolder(strDir).subfoldersFor Each theDir In theDirspt = theDir.Pathpt.Next = theDir.SizelistPath theDir.PathNextSet myFso = NothingEnd SubPrivate Sub CommandButton1_Click()查找文件夹下子文件夹及其大小End Sub3. 用VBA获取文件夹中的文件列表如果我们要在Excel中获取某个文件夹中所有的文件列表，可以通过下面的VBA代码来进行。代码运行后，首先弹出一个浏览文件夹对话框，然后新建一个工作簿，并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。方法如下：1.按Alt+F11，打开VBA编辑器，单击菜单“插入模块”，将下面的代码粘贴到右侧的代码窗口中：Option ExplicitSub GetFileList()Dim strFolder As StringDim varFileList As VariantDim FSO As Object, myFile As ObjectDim myResults As VariantDim l As Long显示打开文件夹对话框With Application.FileDialog(msoFileDialogFolderPicker).ShowIf .SelectedItems.Count = 0 Then Exit Sub 未选择文件夹strFolder = .SelectedItems(1)End With获取文件夹中的所有文件列表varFileList = fcnGetFileList(strFolder)If Not IsArray(varFileList) ThenMsgBox 未找到文件, vbInformationExit SubEnd If获取文件的详细信息，并放到数组中ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)myResults(0, 0) = 文件名myResults(0, 1) = 大小（字节）myResults(0, 2) = 创建时间myResults(0, 3) = 修改时间myResults(0, 4) = 访问时间myResults(0, 5) = 完整路径Set FSO = CreateObject(Scripting.FileSystemObject)For l = 0 To UBound(varFileList)Set myFile = 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.PathNext lfcnDumpToWorksheet myResultsSet myFile = NothingSet FSO = NothingEnd SubPrivate Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant 如果文件夹中包含文件返回一个二维数组，否则返回FalseDim f As StringDim i As IntegerDim FileList() As StringIf strFilter = Then strFilter = *.*Select Case Right$(strPath, 1)Case , /strPath = Left$(strPath, Len(strPath) - 1)End SelectReDim Preserve FileList(0)f = Dir$(strPath & & strFilter)Do While Len(f) 0ReDim Preserve FileList(i) As StringFileList(i) = fi = i + 1f = Dir$()LoopIf FileList(0) Empty ThenfcnGetFileList = FileListElsefcnGetFileList = FalseEnd IfEnd FunctionPrivate Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)Dim iSheetsInNew As IntegerDim sh As Worksheet, wb As WorkbookDim myColumnHeaders() As StringDim l As Long, NoOfRows As LongIf mySh Is Nothing Then新建一个工作簿iSheetsInNew = Application.SheetsInNewWorkbookApplication.SheetsInNewWorkbook = 1Set wb = Application.Workbooks.AddApplication.SheetsInNewWorkbook = iSheetsInNewSet sh = wb.Sheets(1)ElseSet mySh = shEnd IfWith shRange(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1) = varData.UsedRange.Columns.AutoFitEnd WithSet sh = NothingSet wb = NothingEnd Sub2.关闭VBA编辑器，回到Excel工作表中，按Alt+F8，打开“宏”对话框，选择“GetFileList”，单击“运行”按钮。4. VBA中如何取文件的最后修改时间?已经解决了，新的代码-Sub searchfiles()With Application.FileSearch.NewSearch.LookIn = D：ttt.Filename = *.xls.SearchSubFolders = True.FileType = msoFileTypeAllFilesIf .Execute() 0 ThenFor i = 1 To .FoundFiles.CountWorksheets(sheet3).Cells(i, 2).Value = .FoundFiles(i)Dim fs, f, sSet fs = CreateObject(Scripting.FileSystemObject)Set f = fs.GetFile(.FoundFiles(i)s = Created： & f.DateCreatedWorksheets(sheet3).Cells(i, 3).Value = sSet f = NothingSet fs = NothingNext iElseMsgBox no file found.End IfEnd WithEnd Sub5. VBA代码调用浏览文件夹对话框的几种方法2009-05-25 15：241、使用API方法【类型声明】Private Type BROWSEINFOhWndOwner As LongpIDLRoot As LongpszDisplayName As LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd Type【API声明】Private Declare Function SHGetPathFromIDList Lib shell32.dll _Alias SHGetPathFromIDListA (ByVal pidl As Long, _ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib shell32.dll _Alias SHBrowseForFolderA (lpBrowseInfo As BROWSEINFO) As LongPrivate Declare Function lstrcat Lib kernel32 _Alias lstrcatA (ByVal lpString1 As String, _ByVal lpString2 As String) As LongPrivate Declare Function OleInitialize Lib ole32.dll _(lp As Any) As LongPrivate Declare Sub OleUninitialize Lib ole32 ()Private Const BIF_USENEWUI = &H40Private Const MAX_PATH = 260【自定义函数】Public Function GetFolder_API(sTitle As String, Optional vFlags As Variant) As StringDim lpIDList As LongDim sBuffer As StringDim BInfo As BROWSEINFOIf IsMissing(vFlags) Then vFlags = BIF_USENEWUICall OleInitialize(ByVal 0&)With BInfo.lpszTitle = lstrcat(sTitle, ).ulFlags = vFlagsEnd WithlpIDList = SHBrowseForFolder(BInfo)If (lpIDList) ThensBuffer = Space(MAX_PATH)SHGetPathFromIDList lpIDList, sBuffersBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)If sBuffer Then GetFolder_API = sBufferEnd IfCall OleUninitializeEnd Function【使用方法】Sub Test()MsgBox GetFolder_API(选择文件夹)End Sub2、使用Shell.Application方法Sub GetFloder_Shell()Set objShell = CreateObject(Shell.Application)Set objFolder = objShell.BrowseForFolder(0, 选择文件夹, 0, 0)If Not objFolder Is Nothing ThenMsgBox objFolder.self.pathEnd IfSet objFolder = NothingSet objShell = NothingEnd Sub3、使用FileDialog方法Sub GetFloder_FileDialog()Dim fd As FileDialogSet fd = Application.FileDialog(msoFileDialogFolderPicker)If fd.Show = -1 Then MsgBox fd.SelectedItems(1)Set fd = NothingEnd Sub以上方法在WINXP+OFFICE2003中测试通过Excel VBA选择目标文件夹方法2009-04-13 08：496. 用VBA选择目标文件夹几种实现代码：1.FileDialog 属性Sub Sample1()With Application.FileDialog(msoFileDialogFolderPicker)If .Show = True ThenMsgBox .SelectedItems(1)txtFolder.Text = .SelectedItems(1)End IfEnd WithEnd Sub2.shell 方法Sub Sample2()Dim Shell, myPathSet Shell = CreateObject(Shell.Application)Set myPath = Shell.BrowseForFolder(&O0, 请选择文件夹, &H1 + &H10, G：)If Not myPath Is Nothing Then MsgBox myPath.Items.Item.PathSet Shell = NothingSet myPath = NothingEnd Sub3.API 方法Declare Function SHGetPathFromIDList Lib shell32.dll Alias SHGetPathFromIDListA _(ByVal pidl As Long, ByVal pszPath As String) As LongDeclare Function SHBrowseForFolder Lib shell32.dll Alias SHBrowseForFolderA _(lpBrowseInfo As BROWSEINFO) As LongDeclare Function GetDesktopWindow Lib user32 () As LongPublic Type BROWSEINFOhOwner As LongpidlRoot As LongpszDisplayName As StringlpszTitle As StringulFlags As Longlpfn As LonglParam As LongiImage As LongEnd TypeSub Sample3()Dim buf As Stringbuf = GetFolder(请选择文件夹)If buf = Then Exit SubMsgBox bufEnd SubFunction GetFolder(Optional Msg) As StringDim bInfo As BROWSEINFO, pPath As StringDim R As Long, X As Long, pos As IntegerbInfo.pidlRoot = 0&bInfo.lpszTitle = MsgbInfo.ulFlags = &H1X = SHBrowseForFolder(bInfo)pPath = Space$(512)R = SHGetPathFromIDList(ByVal X, ByVal pPath)If R Thenpos = InStr(pPath, Chr$(0)GetFolder = Left(pPath, pos - 1)ElseGetFolder = End IfEnd Function7. VBA代码调用浏览文件夹对话框的几种方法1、使用API方法【类型声明】Private Type BROWSEINFOhWndOwner As LongpIDLRoot As LongpszDisplayName As LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd Type【API声明】Private Declare Function SHGetPathFromIDList Lib shell32.dll _Alias SHGetPathFromIDListA (ByVal pidl As Long, _ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib shell32.dll _Alias SHBrowseForFolderA (lpBrowseInfo As BROWSEINFO) As LongPrivate Declare Function lstrcat Lib kernel32 _Alias lstrcatA (ByVal lpString1 As String, _ByVal lpString2 As String) As LongPrivate Declare Function OleInitialize Lib ole32.dll _(lp As Any) As LongPrivate Declare Sub OleUninitialize Lib ole32 ()Private Const BIF_USENEWUI = &H40Private Const MAX_PATH = 260【自定义函数】Public Function GetFolder_API(sTitle As String, Optional vFlags As Variant) As StringDim lpIDList As LongDim sBuffer As StringDim BInfo As BROWSEINFOIf IsMissing(vFlags) Then vFlags = BIF_USENEWUICall OleInitialize(ByVal 0&)With BInfo.lpszTitle = lstrcat(sTitle, ).ulFlags = vFlagsEnd WithlpIDList = SHBrowseForFolder(BInfo)If (lpIDList) ThensBuffer = Space(MAX_PATH)SHGetPathFromIDList lpIDList, sBuffersBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)If sBuffer Then GetFolder_API = sBufferEnd IfCall OleUninitializeEnd Function【使用方法】Sub Test()MsgBox GetFolder_API(选择文件夹)End Sub2、使用Shell.Application方法Sub GetFloder_Shell()Set objShell = CreateObject(Shell.Application)Set objFolder = objShell.BrowseForFolder(0, 选择文件夹, 0, 0)If Not objFolder Is Nothing ThenMsgBox objFolder.self.pathEnd IfSet objFolder = NothingSet objShell = NothingEnd Sub3、使用FileDialog方法Sub GetFloder_FileDialog()Dim fd As FileDialogSet fd = Application.FileDialog(msoFileDialogFolderPicker)If fd.Show = -1 Then MsgBox fd.SelectedItems(1)Set fd = NothingEnd Sub以上方法在WINXP+OFFICE2003中测试通过8. VBA 操作，删除，新建文件夹Sub qd_name_del() 删除启动查找目录及文件On Error Resume Next 忽略错误,如果有错误发生就执行下一语句Set fs = CreateObject(Scripting.FileSystemObject)Set f = fs.GetFolder(C：Documents and Settingswinxp)f.DeleteEnd Sub简单就是CreateObject(scripting.filesystemobject).getfolder(strpathname).Delete利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。 包括复制、重命名、删除等，其中一些简单的示例总结如下。 希望对一些经常需要批量处理文件的朋友有所帮助，也希望感兴趣的朋友多多指教！以下代码建议在on error resume next下测试 1，在D：下新建文件夹，命名为folder 方法1：MkDir D：folder 方法2：Set abc = CreateObject(Scripting.FileSystemObject) abc.CreateFolder (D：folder)2，新建2个文件命名为a.xls和b.xls Workbooks.Add ActiveWorkbook.SaveAs Filename：=D：foldera.xls ActiveWorkbook.SaveAs Filename：=D：folderb.xls3,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xls MkDir D：folder1 FileCopy D：foldera.xls, D：folder1c.xls4,复制folder中所有文件到folder1 Set qqq = CreateObject(Scripting.FileSystemObject) qqq.CopyFolder D：folder, D：folder15,重命名a.xls为d.xls name d：folder1a.xls as d：folder1d.xls6,判断文件及文件夹是否存在 Set yyy = CreateObject(Scripting.FileSystemObject) If yyy.FolderExists(D：folder1) = True Then . If yyy.FileExists(D：folder1d.xls) = True Then .7,打开folder1中所有文件 Set rrr = CreateObject(Scripting.FileSystemObject) Set r = rrr.GetFolder(d：folder1) For Each i In r.Files Workbooks.Open Filename：=(d：folder1 + i.Name + ) Next8,删除文件c.xls kill d：folder1c.xls9,删除文件夹folder Set aaa = CreateObject(Scripting.FileSystemObject) aaa.DeleteFolder d：folder9. 可以通过控件或者代码新建一个文件夹吗？Dim fso As ObjectSet fso = CreatObject(“Scripting. FileSystemObject”)fso.CreateFolder(foldername)不过运行不了.Set fso = CreatObject(“Scripting. FileSystemObject”)提示这一句有错.但是如果文件夹已经存在了会出错那怎么判断一个文件夹存不存在？Dim fso As New FileSystemObjectif fso.FolderExists folderName thenmsgbox 文件夹已存在！ elsefso.CreateFolder(foldername)end ifFileSystemObject 不能用的话,在工程里添加一下引用 microsoft Scripting runtime 10. 怎么判断一个文件夹存不存在？Dim fso As New FileSystemObjectif fso.FolderExists folderName thenmsgbox 文件夹已存在！ elsefso.CreateFolder(foldername)end ifFileSystemObject 不能用的话,在工程里添加一下引用 microsoft Scripting runtime 11. FolderExists 方法如果指定的文件夹存在，则返回 True；否则返回 False。object.FolderExists(folderspec)参数object必选项。应为 FileSystemObject 的名称。folderspec必选项。文件夹名称，表示要确定是否存在的文件夹。如果该文件夹不在当前文件夹中，则必须提供完整路径名（绝对路径或相对路径）。说明下面例子举例说明如何使用 FolderExists 方法：Function ReportFolderStatus(fldr)Dim fso, msgSet fso = Cr