您现在查看的是网站旧的历史存档页面，此页面将不再更新，如有必要我将适时进行删除。请访问新的网站主页以获取最新信息，谢谢！

利用Scripting.FileSystemObject组件来枚举文件

Posted on

基本的算法思想就是首先获得文件夹下的文件集合，然后枚举文件，然后再获得文件夹下子文件夹的集合，然后递归枚举，实际操作时为了更好的模块化，使用了回调函数，如果找到文件就自动交给指定函数处理，我们约定函数的格式如下：

FUNCTION(FileSystemObject, FileObject, Parameter) RETURN AS BOOL

首先第一个参数是FileSystemObject，就是将创建好的Scripting.FileSystemObject对象传入函数让我们加以利用。
其次第二个参数是FileObject，也就是枚举出的单独文件对象，我们可以通过这个对象获得文件一系列的属性和方法。
最后一个参数是Parameter，是在调用枚举时传入的参数，没有特殊需要可以忽略。
返回值，如果返回TRUE则中止枚举，否则将继续枚举直到枚举结束。

VBScript实现如下。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

Class FileOperation
 
    Private AxFile   
    Private Sub Class_Initialize()
        Set AxFile = WSH.CreateObject("Scripting.FileSystemObject")
    End Sub
 
    Private Sub Class_Terminate()
        Set AxFile = Nothing
    End Sub
 
    Private Function GetSubFolders(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFolders = oFolders.SubFolders
            Set oFolders = Nothing
        Else
            Set GetSubFolders = Nothing
        End If
    End Function
 
    Private Function GetSubFiles(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFiles = oFolders.Files
            Set oFolders = Nothing
        Else
            Set GetSubFiles = Null
        End If
    End Function
 
    Public Function EnumFiles(strFolder, fCallBackName, Param)
        EnumFiles = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFiles = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFiles, SubFile, SubFolders, SubFolder
 
        Set fCallBack = GetRef(fCallBackName)
 
        Set SubFiles = GetSubFiles(strFolder)
        For Each SubFile In SubFiles
            If fCallBack(AxFile, SubFile, Param) Then Exit For
        Next
        Set SubFiles = Nothing
 
        Set SubFolders = GetSubFolders(strFolder)
        For Each SubFolder In SubFolders
            Call EnumFiles(AxFile.GetAbsolutePathName(SubFolder), _
                                  fCallBackName, Param)
        Next
        Set SubFolders = Nothing
 
        Set fCallBack = Nothing
    End Function
 
End Class

貌似VBScript没有函数指针的概念，在查阅了脚本手册后找到GetRef函数，用以根据字符串格式的函数名获取函数的引用，虽然看上去比较别扭，但是还是可以实现函数指针这个功能的。

JavaScript/JScript实现如下。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

function FileOperation() {
    this.self = WSH.CreateObject("Scripting.FileSystemObject");
 
    this.getSubFolders = function(fdr) {
        if (!this.self.FolderExists(fdr))
            return null;
        return (this.self.GetFolder(fdr).SubFolders);
    }
 
    this.getSubFiles = function(fdr) {
        if (!this.self.FolderExists(fdr))
            return null;
        return (this.self.GetFolder(fdr).Files);
    }
 
    this.enumFiles = function(fdr, callback, param) {
        if (!this.self.FolderExists(fdr))
            return false;
        var SubFiles = new Enumerator(this.getSubFiles(fdr));
        for (; !SubFiles.atEnd(); SubFiles.moveNext())
        {
            if (callback(this.self, SubFiles.item(), param))
                return true;
        }
        var SubFolders = new Enumerator(this.getSubFolders(fdr));
        for (; !SubFolders.atEnd(); SubFolders.moveNext()) {
            this.enumFiles(
            this.self.GetAbsolutePathName(SubFolders.item()),
            callback, param);
        }
        return true;
    }
}

JavaScript/JScript的将函数名作为变量传入很方便的实现了函数指针的功能，在这点上JavaScript/JScript的灵活性还是略胜一筹的，不过其foreach功能就没有VBScript那么好用了。

2012年3月21日更新

对VBScript类做了修改，增加了文件夹枚举搜索，增加递归开关，并且为了保证调用灵活，修改了回调原型函数。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

' Author : wangye
' http://wangye.org
Class FileOperation
 
    Private AxFile   
    Private Sub Class_Initialize()
        Set AxFile = WSH.CreateObject("Scripting.FileSystemObject")
    End Sub
 
    Private Sub Class_Terminate()
        Set AxFile = Nothing
    End Sub
 
    Private Function GetSubFolders(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFolders = oFolders.SubFolders
            Set oFolders = Nothing
        Else
            Set GetSubFolders = Nothing
        End If
    End Function
 
    Private Function GetSubFiles(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFiles = oFolders.Files
            Set oFolders = Nothing
        Else
            Set GetSubFiles = Null
        End If
    End Function
 
    ' EnumFiles 枚举指定文件夹文件
    '
    ' 回调函数原型为 CallBack(self, fso, file, param)
    '     self  Class FileOperation实例化对象
    '     fso   Scripting.FileSystemObject对象
    '     file  枚举到的文件对象
    '     param 传递给回调函数的参数（如果需要）
    '
    ' strFolder     要枚举的文件所在的文件夹
    ' fCallBackName 列出的每个文件所调用的回调函数名称
    ' Recursion     是否递归搜索
    ' Param         传递给回调函数的参数（如果需要）
    Public Function EnumFiles(strFolder, fCallBackName, Recursion, Param)
        EnumFiles = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFiles = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFiles, SubFile, SubFolders, SubFolder
 
        Set fCallBack = GetRef(fCallBackName)
 
        If TypeName(strFolder) = "Folder" Then
            Set SubFiles = strFolder.Files
        Else
            Set SubFiles = GetSubFiles(strFolder)
        End If
        For Each SubFile In SubFiles
            If fCallBack(Me, AxFile, SubFile, Param) Then Exit For
        Next
        Set SubFiles = Nothing
 
        If Recursion Then
        Set SubFolders = GetSubFolders(strFolder)
            For Each SubFolder In SubFolders
                Call EnumFiles(AxFile.GetAbsolutePathName(SubFolder), _
                          fCallBackName, Recursion, Param)
            Next
            Set SubFolders = Nothing
        End If
 
        Set fCallBack = Nothing
    End Function
 
    ' EnumFolders 枚举指定文件夹
    '
    ' 回调函数原型为 CallBack(self, fso, folder, param)
    '     self  Class FileOperation实例化对象
    '     fso   Scripting.FileSystemObject对象
    '     folder  枚举到的文件夹对象
    '     param 传递给回调函数的参数（如果需要）
    '
    ' strFolder     要枚举的文件夹所在的文件夹
    ' fCallBackName 列出的每个文件夹所调用的回调函数名称
    ' Recursion     是否递归搜索
    ' Param         传递给回调函数的参数（如果需要）
    Public Function EnumFolders(strFolder, fCallBackName, Recursion, Param)
        EnumFolders = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFolders = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFolders, SubFolder, ChildFolders, ChildFolder
 
        Set fCallBack = GetRef(fCallBackName)
        Set SubFolders = GetSubFolders(strFolder)
        For Each SubFolder In SubFolders
            If fCallBack(Me, AxFile, SubFolder, Param) Then Exit For
            If Recursion Then
                Set ChildFolders = SubFolder.SubFolders
                For Each ChildFolder In ChildFolders
                    If fCallBack(Me, AxFile, ChildFolder, Param) Then Exit For
                    Call EnumFolders(AxFile.GetAbsolutePathName(ChildFolder), _
                              fCallBackName, Recursion, Param)
                Next
                Set ChildFolders = Nothing
            End If
        Next
        Set SubFolders = Nothing
        Set fCallBack = Nothing
    End Function
End Class
 
' Example:
' Function ParseFiles(self, fso, file, param)
'     WSH.Echo file.Name & " at " & fso.GetAbsolutePathName(file)
' End Function
' Dim fp
' Set fp = New FileOperation
'     fp.EnumFiles "C:\", "ParseFiles", True, Null
' Set fp = Nothing

One thought on “利用Scripting.FileSystemObject组件来枚举文件”

  1. Pingback： Definite Digest » VBA/VBScript批量搜索多个Word或者Excel指定的包含文字

Comments are closed.

您现在查看的是网站旧的历史存档页面，此页面将不再更新，如有必要我将适时进行删除。请访问新的网站主页以获取最新信息，谢谢！