2022年excel中文件和文件夹操作 .pdf

《2022年excel中文件和文件夹操作 .pdf》由会员分享，可在线阅读，更多相关《2022年excel中文件和文件夹操作 .pdf（15页珍藏版）》请在得力文库 - 分享文档赚钱的网站上搜索。

1、文件和文件夹操作我们在使用Excel VBA 进行处理数据时，或多或少会涉及到如何操作文件和文件夹。本节将重点讲述如何新建、打开、删除、复制、移动和重命名文件和文件夹操作等。对于文件和文件夹操作，我们一般通过下面方法：VB 命令EXCEL 对象引用其他动态库对象API 函数在这里， 我们尽可能通过不同的方法来展示如何操作文件和文件夹。注意，这里所涉及的文件一般以Excel 为主。对于如何运用文件之间的处理，如，文本文件、WORD 、ACCESS 和 PPT 与 EXCEL之间的互访与查询，我们将在下节中讲解。在本节开始之前，我们需要预备的知识点：1、如何引用动态工程库。打开 VBE- 工具 -

2、引用选择 Microsoft Scripting Runtime动态库下面我们将会频繁用到Scripting.FileSystemObject 对象来操作文件和文件夹。另，此 scrrun.dll 动态库还包含了Scripting.Dictionary字典对象。名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，共 15 页 - - - - - - - - - 2、前期绑定和后期绑定我们知道， VB 是面向对象化编程，MS 提供很多的DLL 动态链接库，通过这些对象，我们可以轻松

3、地完成任务。我们可以通过前期绑定或后期绑定来引用DLL 库。1） 前期绑定。如同我们在上面用手动引用动态工程库方式，在编译代码前，我们就完成了的绑定。绑定之后，写入下面代码，创建和引用对象：Sub BandObject() Dim fso As Scripting.FileSystemObject Set fso = New Scripting.FileSystemObject DIM FSO NEW Scripting.FileSystemObject End Sub 2） 后期绑定。使用CreateObject 函数，绑定某一个对象。此时，我们只有在程序运行时，绑定才有效，如，Sub Cr

4、tObject() Dim ObjFso As Object Set ObjFso = CreateObject(Scripting.FileSystemObject) End Sub 3、小结：1） 、前期和后期绑定区别在于定义方式和创建方式不同。2） 、前期绑定的优势在于，可以使用自动列出成员方式，查看对象的方法和属性；而后期绑定无法使用。3） 、小心后期绑定的写法。不是所有的后期绑定都是和前期绑定的对象写法一致。如，对象库： Microsoft Shell Controls And Automation 前期绑定：Dim oShell As Shell32.Shell Set oShel

5、l = New Shell32.Shell 后期绑定：Dim oShell As Object Set oShell = CreateObject(Shell.Application) 一、 文件操作1、 新建 Excel 文件Excel 对象： Add 方法：Sub AddWorkBook() Dim wb As Workbook Set wb = Workbooks.Add End Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 15 页 - - - - -

6、- - - - Sub AddFile() Dim wb As Workbook Set wb = Workbooks.Add wb.SaveAs ThisWorkbook.Path & Temp.xls wb.Close Set wb = Nothing End Sub 2、 打开文件1） 、 EXCEL 对象： Open 方法直接打开一个工作簿。expression.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Deli

7、miter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad, OpenConflictDocument) Sub OpenWorkbook() Dim wb As Workbook Dim strWb As String strWb = ThisWorkbook.Path & Temp.xls Set wb = Workbooks.Open(strWb) End Sub Sub OpenWorkbook2() Dim wb As Workbook Dim strWb As String strWb = ThisWorkboo

8、k.Path & Temp.xls Set wb = Workbooks.Open(strWb, UpdateLinks:=False) End Sub 2） 、 Excel 对象： OpenText Sub OpenText() Dim strFile As String Dim i As Long strFile = ThisWorkbook.Path With Application.FileSearch Application.DefaultWebOptions.LoadPictures = False 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - -

9、- - - - - - - - 名师精心整理 - - - - - - - 第 3 页，共 15 页 - - - - - - - - - .LookIn = strFile .Filename = *.html .Execute If .Execute() 0 Then For i = 1 To .FoundFiles.Count Workbooks.OpenText .FoundFiles(i) Next End If Application.DefaultWebOptions.LoadPictures = True End With End Sub 3） 、 Office 对象： FileD

10、ialog 通过浏览方式打开文件Sub OpenFile_FileDialog() Dim fd As FileDialog Dim FFs As FileDialogFilters Dim vaItem As Variant Dim myWb As Workbook Set fd = Application.FileDialog(msoFileDialogOpen) With fd Set FFs = .Filters With FFs .Clear .Add Excel 文件 , *.xls;*.xla End With .AllowMultiSelect = True If .Show

11、= -1 Then For Each vaItem In .SelectedItems Set myWb = Workbooks.Open(vaItem) Next vaItem End If End With End Sub 4） 、 API 函数方式打开所有类型的文件Const SW_SHOW = 5 Private Declare Function ShellExecute Lib shell32.dll Alias _ ShellExecuteA (ByVal hwnd As Long, ByVal lpOperation As String, _ ByVal lpFile As St

12、ring, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 4 页，共 15 页 - - - - - - - - - Sub OpenFiles() Dim varFName As Variant Dim fn As Variant Excel 档由 Excel 开,其它文档由ShellExecute

13、 函数开varFName = Application.GetOpenFilename(, , 开启文档 , MultiSelect:=True) If IsArray(varFName) Then For Each fn In varFName If LCase(Right(fn, 3) xls Then ShellExecute 0, open, fn, , , SW_SHOW Else Workbooks.Open (fn) End If Next End If End Sub 3、 保存文件1） 、 Excel 对象： Save Sub SaveWorkbook() ThisWorkbo

14、ok.Save End Sub 2） 、 Excel 对象： SaveAs Sub SaveAsWorkbook() Dim strFileName As String strFileName = ThisWorkbook.Path & test.xls On Error Resume Next ThisWorkbook.SaveAs strFileName End Sub 3） 、 Excel 对象： SaveCopyAs Sub SaveCopyAsWorkbook() Dim strFileName As String strFileName = ThisWorkbook.Path &

15、test.xls On Error Resume Next ThisWorkbook.SaveCopyAs strFileName End Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 5 页，共 15 页 - - - - - - - - - 4、 判断文件夹是否存在1） 、 VB 命令： Dir() Sub FileExist_Dir() Dim strFile As String strFile = ThisWorkbook.Path & test.xls If Dir

16、(strFile) = Then MsgBox strFile & does not Exists Else MsgBox strFile & Exist End If End Sub 2） 、 FileSystemObject 对象： FileExists 方法Sub FileExist_Fso() Dim fso As FileSystemObject Dim strFile As String strFile = ThisWorkbook.Path & test.xls Set fso = New FileSystemObject If fso.FileExists(strFile) T

17、hen MsgBox strFile & Exist Else MsgBox strFile & does not Exists End If End Sub 5、 建立文件的桌面快捷方式WScript 对象： CreateShortCut 方法Sub DesktopShortCut() Dim WSHShell As Object Dim MyShortcut As Object Dim DesktopPath As String Set WSHShell = CreateObject(WScript.Shell) DesktopPath = WSHShell.SpecialFolders(

18、Desktop) Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & & _ ThisWorkbook.Name & .lnk) With MyShortcut .TargetPath = ThisWorkbook.FullName .Save End With Set WSHShell = Nothing 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 6 页，共 15 页 - - - - - - - - - MsgBox

19、已经在桌面生成快捷方式. End Sub 6、 移动文件1） 、 FileSystemObject 对象： MoveFilet Sub MoveFile_fso() Dim fso As New FileSystemObject Dim strSourceFile As String Dim strDestination As String strSourceFile = ThisWorkbook.Path & Temp.xls strDestination = ThisWorkbook.Path & MoveFileTemp.xls If Not fso.FileExists(strSour

20、ceFile) Then MsgBox File does not Exists., vbCritical Else fso.MoveFile strSourceFile, strDestination MsgBox File Move to & strDestination End If Set fso = Nothing End Sub 2） 、 Office 对象： Name Sub MoveFile() Dim fso As New FileSystemObject Dim strSourceFile As String Dim strDestination As String On

21、Error GoTo ErrHandle strSourceFile = ThisWorkbook.Path & Temp.xls strDestination = ThisWorkbook.Path & MoveFileTemp.xls dir(strSourceFile)= ”? Name strSourceFile As strDestination Exit Sub ErrHandle: MsgBox Err.Description, vbCritical End Sub 7、 复制文件1） 、 Office 对象： FileCopy Sub CopyFile() 名师资料总结 - -

22、 -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 7 页，共 15 页 - - - - - - - - - Dim strSfile As String Dim strDfile As String strSfile = ThisWorkbook.Path & Temp.xls strDfile = ThisWorkbook.Path & TempTemp.xls FileCopy strSfile, strDfile End Sub 2） 、 FileSystemObject 对象： CopyFile

23、Sub CopyFile_fso() Dim strSfile As String Dim strDfile As String Dim fso As New FileSystemObject strSfile = ThisWorkbook.Path & Temp.xls strDfile = ThisWorkbook.Path & TempTemp.xls fso.CopyFile strSfile, strDfile Set fso = Nothing End Sub 8、 关闭文件Excel 对象： Close 方法Sub CloseWorkbook() ThisWorkbook.Clo

24、se False End Sub 9、 文件重命名Office 对象： Name Public oldNames() As String, newNames() As String Sub ReNameFiles() Dim i As Integer, iCount As Integer Dim Oldname As String, Newname As String Dim strExName As String, strPath As String strExName = .jpg strPath = ThisWorkbook.Path & Rename Pic With Applicat

25、ion.FileSearch .NewSearch .LookIn = strPath .SearchSubFolders = False 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 8 页，共 15 页 - - - - - - - - - .Filename = * & strExName .MatchTextExactly = True .FileType = msoFileTypeAllFiles On Error GoTo ErrH If .Execute() 0 The

26、n iCount = .FoundFiles.Count MsgBox There were & iCount & file(s) found., 0 + 64, 系统 ReDim oldNames(iCount) ReDim newNames(iCount) For i = 1 To iCount Newname = i & strExName newNames(i) = CStr(strPath & & Newname) oldNames(i) = CStr(.FoundFiles(i) Name CStr(oldNames(i) As newNames(i) Next i Else Ms

27、gBox There were no files found. End If Application.OnUndo 撤销重命名 , UnChangePicName End With Exit Sub ErrH: MsgBox Err.Description, vbCritical End Sub Sub UnChangePicName() 撤销重命名图片Dim i As Integer For i = 1 To UBound(newNames) Name newNames(i) As oldNames(i) Next i Application.OnRepeat 重做重命名 , my_Repe

28、at End Sub Sub my_Repeat() 恢复重命名图片Dim i As Integer For i = 1 To UBound(newNames) Name oldNames(i) As newNames(i) Next i Application.OnUndo 撤销重命名 , UnChangePicName End Sub 10、删除文件1） 、 VB 语句： Kill 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 9 页，共 15 页 - - - - - - -

29、- - Sub DeleteFile() Dim strFile As String strFile = ThisWorkbook.Path & Temp.xls Kill strFile End Sub Sub DeleteFile2() Dim strFile As String strFile = ThisWorkbook.Path & Temp.xls If Dir(strFile) = Then MsgBox strFile & does not Exists, vbCritical Else Kill strFile End If End Sub 2） 、 FileSystemOb

30、ject 对象： DeleteFile 方法Sub DeleteFile_Fso() Dim fso As FileSystemObject Dim strFile As String strFile = ThisWorkbook.Path & test.xls Set fso = New FileSystemObject If fso.FileExists(strFile) Then fso.DeleteFile strFile Else MsgBox strFile & does not Exists End If Set fso = Nothing End Sub 10、文件自杀VB 语

31、句： Kill Sub KillMe() Application.DisplayAlerts = False ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.FullName ThisWorkbook.Close False End Sub 二、文件夹操作名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 10 页，共 15 页 - - - - - - - - - 1、 新建文件夹Sub MkDirFolder

32、() Dim strfolder As String strfolder = ThisWorkbook.Path & Temp On Error GoTo ErrHandle MkDir strfolder MsgBox Create New Folder: & strfolder, vbInformation On Error GoTo 0 Exit Sub ErrHandle: MsgBox Folder already Exists., vbInformation End Sub Sub MakeFolder_fso() Dim fso As New FileSystemObject D

33、im strfolder As String strfolder = ThisWorkbook.Path & Temp If Not fso.FolderExists(strfolder) Then fso.CreateFolder strfolder MsgBox Create a Temp folder., vbInformation Else MsgBox Folder already Exists., vbInformation End If Set fso = Nothing End Sub 2、 打开文件夹1） 、 Shell Sub ShellFolder() Shell exp

34、lorer.exe E:inbox, 1 End Sub 2)、引用 Microsoft Shell Controls And Automation动态库名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 11 页，共 15 页 - - - - - - - - - Sub OpenFolder() Dim strFolder As String Dim oShell As Shell32.Shell Set oShell = New Shell32.Shell strFolder = E

35、:inbox oShell.Explore strFolder End Sub 3） 后期绑定方式，选择文件夹Sub SelectFolder() Dim Shapp As Object Dim Path1 As Object Set Shapp = CreateObject(Shell.Application) Set Path1 = Shapp.BrowseForFolder(0, 请选择文件夹, 0, 0) If Path1 Is Nothing Then Exit Sub MsgBox Path1.Self.Path End Sub 3、 复制文件夹FileSystemObject 对

36、象： CopyFolderSub CopyFile_fso() Dim fso As New FileSystemObject Dim strSfolder As String Dim strDfolder As String strSfolder = ThisWorkbook.Path & Temp strDfolder = ThisWorkbook.Path & MoveFile fso.CopyFolder strSfolder, strDfolder Set fso = Nothing End Sub 4、 移动文件夹FileSystemObject 对象： MoveFolderSub

37、 MoveFolder_fso() Dim fso As New FileSystemObject Dim strSfolder As String Dim strDfolder As String strSfolder = ThisWorkbook.Path & Temp 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 12 页，共 15 页 - - - - - - - - - strDfolder = ThisWorkbook.Path & MoveFile If Not fso

38、.FolderExists(strSfolder) Then MsgBox Folder does not Exists., vbCritical Else fso.MoveFolder strSfolder, strDfolder MsgBox Folder Move to & strDfolder End If Set fso = Nothing End Sub 5、 删除文件夹VB 语句： RmDir Sub DeleteFolder() Dim strFolder As String strFolder = ThisWorkbook.Path & Temp On Error GoTo

39、ErrHandle RmDir strFolder MsgBox Delete Folder: & strFolder, vbInformation On Error GoTo 0 Exit Sub ErrHandle: MsgBox Folder does not Exists., vbCritical End Sub Shell 语句Sub DeleteFolder2() KillFolder ThisWorkbook.Path & Temp End Sub Sub KillFolder(MyFolderPath As String) Shell cmd.exe /c rmdir /s/q

40、 & Chr(34) & MyFolderPath & Chr(34) End Sub FileSystemObject 对象： DeleteFolderSub DeleteFolder_fso() Dim strFolder As String Dim fso As New FileSystemObject strFolder = ThisWorkbook.Path & Temp If fso.FolderExists(strFolder) Then 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - -

41、 - - - 第 13 页，共 15 页 - - - - - - - - - fso.DeleteFolder strFolder Else MsgBox Folder does not Exists., vbCritical End If Set fso = Nothing End Sub 6、 获取父文件夹名FileSystemObject 对象： ParentFolder Sub ParentFolderName_fso() Dim fso As New FileSystemObject Dim strPath As String strPath = ThisWorkbook.Path

42、& Temp MsgBox Path: & strPath & vbCrLf & vbCrLf & _ Paren Path: & fso.GetFolder(strPath).ParentFolder.Name End Sub VBA ：Split 函数Sub ParentFolderName() Dim arr As Variant Dim strPath As String strPath = ThisWorkbook.Path & Temp arr = Split(strPath, ) MsgBox Path: & strPath & vbCrLf & vbCrLf & _ Paren

43、 Path: & arr(UBound(arr) - 1) End Sub 7、 文件夹重命名FileSystemObject 对象： Folder.name Dim OldFolder As String, NewFolder As String Sub ReNameFolder_fso() Dim fso As New FileSystemObject Dim oFolder As Folder Dim strOldFolder As String Dim strNewFolder As String strOldFolder = ThisWorkbook.Path & Temp strN

44、ewFolder = New Temp 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 14 页，共 15 页 - - - - - - - - - If Not fso.FolderExists(strOldFolder) Then MsgBox Folder does not Exist., vbCritical Else Set oFolder = fso.GetFolder(strOldFolder) oFolder.Name = strNewFolder End If End

45、 Sub VB 语句： Name Sub ReNameFolder() OldFolder = ThisWorkbook.Path & Temp NewFolder = ThisWorkbook.Path & New Temp Name OldFolder As NewFolder End Sub Sub UnChangeReNameFolder() Name NewFolder As OldFolder End Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 15 页，共 15 页 - - - - - - - - -