Excel-VBA查找文件并备份

应用场景

快速查找符合要求的文件并备份

知识要点

1：CreateObject 函数 创建并返回一个对 ActiveX 对象的引用。

2：wscript.shell WScript.Shell是WshShell对象的ProgID，创建WshShell对象可以运行程序、操作注册表、创建快捷方式、访问系统文件夹、管理环境变量。

3：CreateObject('WScript.shell').specialfolders('Desktop') 获取桌面文件夹

4：CreateFolder 方法  创建一个文件夹。

5：CopyFile 方法 把一个或多个文件从一个地方复制到另一个地方。

6：Replace函数 回一个字符串，该字符串中指定的子字符串已被替换成另一子字符串，并且替换发生的次数也是指定的

7：Split函数 返回一个下标从零开始的一维数组，它包含指定数目的子字符串

Dim arr(), i '声明公共变量，供两个过程调用

Sub 查找表并备份到桌面() '在D盘查找所有'3月生产表.xls'  ，然后备份到桌面备份文件夹中，备份文件名等于原文件名加上其上层文件夹名

    Dim pathstr As String

    Dim j

    pathstr = CreateObject('WScript.shell').specialfolders('Desktop') & '\备份\'

    '如果桌面不存在备份文件夹，那么利用FSO对象创建一个文件夹

    If Len(Dir(pathstr, vbDirectory)) = 0 Then

        CreateObject('Scripting.FileSystemobject').createfolder pathstr

    End If

    i = 0

    Call 查找('D:\')  '调用查找程序

    If i > 0 Then '如果文件数量大于0

        For j = 1 To i  '遍历每个文件(数组的每个元素)

            '利用FSO技术的CopyFile方法进行文件复制，复制后的文件等于文件夹名加文件名

            '其中桌面的地址由脚本语言WScript取得

            'split函数，返回一个下标从0开始的一维数组，它包含指定数目的子字符串

            'replace函数，返回一个字符串，该字符串中指定的子字符串已被替换成另外一子字符串，并且替换发生的次数也是指定的。

            CreateObject('Scripting.FileSystemObject').copyfile arr(j), _

            CreateObject('WScript.shell').specialfolders('Desktop') & '\备份\(' & Replace(Split(arr(j), '\')(UBound(Split(arr(j), '\')) - 1) & ')' & Split(arr(j), '\')(UBound(Split(arr(j), '\'))), ':', '盘')

        Next

    End If

End Sub

Public Sub 查找(ByVal 路径 As String) '查找文件过程

    Dim dirs() As String, dir_count As Long, file_name As String, file_name_2 As String, j

    If Right(路径, 1) <> '\' Then 路径 = 路径 & '\' '如果路径最后一位非'\'，则追加一个'\'

    file_name = Dir(路径 & '*.*', vbDirectory) '获取文件名称

    Do While Len(file_name) <> 0 '只要文件目录名存在(目录字符长度大于0)就循环下去

        If Left$(file_name, 1) <> '.' Then  '如果左边第一个字符为'.'

            file_name_2 = 路径 & file_name '获取子目录

            'getattr函数，返回一个integer，此为一个文件、目录、或文件夹的属性，getattr(pathname）

            If (GetAttr(file_name_2) And vbDirectory) = vbDirectory Then '如果是文件夹

                dir_count = dir_count 1 '计算目录数量

                ReDim Preserve dirs(1 To dir_count) As String  '重新声明数组的存储空间

                dirs(dir_count) = file_name_2 '将子目录写入数组dirs中

            Else

                If file_name = '3月生产表.xls' Then

                    i = i 1

                    ReDim Preserve arr(1 To i)  '重新声明数组的存储空间

                    arr(i) = 路径 & file_name   '将文件名写入数组

                End If

            End If

        End If

        file_name = Dir()  '查找下一个文件

    Loop

    For j = 1 To dir_count  '遍历数组dirs ，即将子目录进行查找

        查找 dirs(j)  '通过自身在执行查找

    Next j

End Sub