Public Sub test1()

     Dim path

     Dim filename

     Dim folders( To )

     Dim i%, j%

     i =

     j =

 '    1. 先获取所有的文件夹

     path = ThisWorkbook.path & "\oriFolder\"

     folders() = path

 '    这里的folders数组和下面的classes数组只设置了100个长度，是为了调试方便，不然有时会出现大量空行，实际中可以增大。

 '    dir第二次无参数调用，返回的是同一个文件夹下的第二个文件！！

 '    filename = Dir(folders(i), vbDirectory)这里filename获取的首先是folders(1)路径下的文件夹"."

 '    dir找到第一个文件夹"."，这时i=1，进入do循环，把oriFolder这一层的文件夹都dir出来(101和102)，

 '    找到一个文件夹就把j加1(最后j=3)，把folders(i)修改为"."路径，101路径和102路径，里面的do until循环就做了这么个事

 '    do until做完之后，i要加1了，变成2，这时的filename = Dir(folders(i), vbDirectory)，folders(2)就是do until循环里已经修改的101路径了，

 '    继续do until循环，j目前=3，然后开始增加，目的是让folders(j)数组继续往后增加元素，等把101路径里所有文件夹路径添加进去之后，

 '    i变成3，再开始遍历102文件夹

 '    如果101里面还有文件夹，就等把101和102都遍历完后，因为i每次只加1，而j是只要有一个文件夹就加1，

 '    所以只要i没有到j的数量，就会一直遍历下去，把所有的子文件遍历出来

     Do While i <= j

         filename = Dir(folders(i), vbDirectory) ' filename="."

         Do Until filename = ""

             If InStr(filename, ".") =  Then

                  j = j +

 '                当i=1的时候，folders(j)中的1,2,3分别是",",101,102目录

                 folders(j) = folders(i) & filename & "\"

             End If

             filename = Dir

         Loop

         i = i +

     Loop

 '    For p = 1 To UBound(folders)

 '        If folders(p) <> "" Then

 '            Debug.Print (folders(p))

 '        End If

 '    Next

 '    2. 从每个文件夹里获取所有课，存入一个数组

 Dim classes( To )

 Dim class

 Dim p

 Dim q

 p =

 q = 

 For p =  To UBound(folders)

     If folders(p) <> "" Then

         class = Dir(folders(p) & "*.*")

         Do Until class = ""

             classes(q) = folders(p) & class

             q = q +

             class = Dir

         Loop

     End If

 Next

 '3. 在desFolder里新建文件夹，生成点拨rtf

 Dim path2

 '先来一套正则相关的dim as

 Dim reg As RegExp

 Dim myMatches As MatchCollection

 Dim myMatch As match

 Dim books( To )

 Dim bNum

 Dim m

 Dim n

 n =

 m =

 bNum =

 '再来一套操作word的dim as

 Dim wordApp As Word.Application

 Set wordApp = New Word.Application

 path2 = ThisWorkbook.path & "\desFolder\"

 Set reg = New RegExp

 '获取所有版本文件夹名

 filename2 = Dir(path, vbDirectory)

 Do Until filename2 = ""

     If InStr(filename2, ".") =  Then

         books(bNum) = filename2

         bNum = bNum +

     End If

     filename2 = Dir

 Loop

 '在desFolder里面生成版本文件夹

 For m =  To UBound(books)

 '    books(m)不为空，并且文件夹不存在，就新建文件夹

     If books(m) <> "" And Dir(path2 & books(m), vbDirectory) = "" Then

         MkDir (path2 & books(m))

 '        新建word，命名为“01_《繁星》_DianBo.doc”

 '        打开每课，查找点拨，复制到word中，格式为1-1-2-1-1【点拨】，第1单元-第1课-2复习-1课堂回顾-第1个点拨

         For n =  To UBound(classes)

             If classes(n) <> "" Then

                 wordApp.Documents.Open (classes(n))

             End If

         Next

     End If

 Next

 'For x = 1 To UBound(classes)

 '    If classes(x) <> "" Then

 '        reg.Global = True '全局匹配

 '        reg.IgnoreCase = True '忽略大小写

 '        reg.Pattern = "(,*)?101_.*" '正则表达式

 '        Set myMatches = reg.Execute(classes(x)) '匹配到的结果返回到myMatches集合

 '        For Each myMatch In myMatches '遍历myMatches集合

 '            If myMatch <> "" Then

 '                Debug.Print (classes(x))

 '            End If

 '        Next

 '

 '    End If

 'Next

 End Sub