说明(2017.3.26):
1. 还没写完,写到新建文件夹了,下一步新建word,重命名,查找点拨,把点拨复制进去,因为要给点拨编号,应该会很麻烦
1 Public Sub test1() 2 Dim path 3 Dim filename 4 Dim folders(1 To 100) 5 Dim i%, j% 6 i = 1 7 j = 1 8 ' 1. 先获取所有的文件夹 9 path = ThisWorkbook.path & "oriFolder" 10 folders(1) = path 11 ' 这里的folders数组和下面的classes数组只设置了100个长度,是为了调试方便,不然有时会出现大量空行,实际中可以增大。 12 ' dir第二次无参数调用,返回的是同一个文件夹下的第二个文件!! 13 ' filename = Dir(folders(i), vbDirectory)这里filename获取的首先是folders(1)路径下的文件夹"." 14 ' dir找到第一个文件夹".",这时i=1,进入do循环,把oriFolder这一层的文件夹都dir出来(101和102), 15 ' 找到一个文件夹就把j加1(最后j=3),把folders(i)修改为"."路径,101路径和102路径,里面的do until循环就做了这么个事 16 ' do until做完之后,i要加1了,变成2,这时的filename = Dir(folders(i), vbDirectory),folders(2)就是do until循环里已经修改的101路径了, 17 ' 继续do until循环,j目前=3,然后开始增加,目的是让folders(j)数组继续往后增加元素,等把101路径里所有文件夹路径添加进去之后, 18 ' i变成3,再开始遍历102文件夹 19 ' 如果101里面还有文件夹,就等把101和102都遍历完后,因为i每次只加1,而j是只要有一个文件夹就加1, 20 ' 所以只要i没有到j的数量,就会一直遍历下去,把所有的子文件遍历出来 21 Do While i <= j 22 filename = Dir(folders(i), vbDirectory) ' filename="." 23 Do Until filename = "" 24 If InStr(filename, ".") = 0 Then 25 j = j + 1 26 ' 当i=1的时候,folders(j)中的1,2,3分别是",",101,102目录 27 folders(j) = folders(i) & filename & "" 28 End If 29 filename = Dir 30 Loop 31 i = i + 1 32 Loop 33 ' For p = 1 To UBound(folders) 34 ' If folders(p) <> "" Then 35 ' Debug.Print (folders(p)) 36 ' End If 37 ' Next 38 ' 2. 从每个文件夹里获取所有课,存入一个数组 39 Dim classes(1 To 100) 40 Dim class 41 Dim p 42 Dim q 43 p = 1 44 q = 1 45 46 For p = 1 To UBound(folders) 47 If folders(p) <> "" Then 48 class = Dir(folders(p) & "*.*") 49 Do Until class = "" 50 classes(q) = folders(p) & class 51 q = q + 1 52 class = Dir 53 Loop 54 End If 55 Next 56 57 58 '3. 在desFolder里新建文件夹,生成点拨rtf 59 Dim path2 60 '先来一套正则相关的dim as 61 Dim reg As RegExp 62 Dim myMatches As MatchCollection 63 Dim myMatch As match 64 Dim books(1 To 10) 65 Dim bNum 66 Dim m 67 Dim n 68 n = 1 69 m = 1 70 bNum = 1 71 '再来一套操作word的dim as 72 Dim wordApp As Word.Application 73 Set wordApp = New Word.Application 74 path2 = ThisWorkbook.path & "desFolder" 75 Set reg = New RegExp 76 '获取所有版本文件夹名 77 filename2 = Dir(path, vbDirectory) 78 Do Until filename2 = "" 79 If InStr(filename2, ".") = 0 Then 80 books(bNum) = filename2 81 bNum = bNum + 1 82 End If 83 filename2 = Dir 84 Loop 85 '在desFolder里面生成版本文件夹 86 For m = 1 To UBound(books) 87 ' books(m)不为空,并且文件夹不存在,就新建文件夹 88 If books(m) <> "" And Dir(path2 & books(m), vbDirectory) = "" Then 89 MkDir (path2 & books(m)) 90 ' 新建word,命名为“01_《繁星》_DianBo.doc” 91 ' 打开每课,查找点拨,复制到word中,格式为1-1-2-1-1【点拨】,第1单元-第1课-2复习-1课堂回顾-第1个点拨 92 93 For n = 1 To UBound(classes) 94 If classes(n) <> "" Then 95 wordApp.Documents.Open (classes(n)) 96 97 End If 98 Next 99 End If 100 Next 101 'For x = 1 To UBound(classes) 102 ' If classes(x) <> "" Then 103 ' reg.Global = True '全局匹配 104 ' reg.IgnoreCase = True '忽略大小写 105 ' reg.Pattern = "(,*)?101_.*" '正则表达式 106 ' Set myMatches = reg.Execute(classes(x)) '匹配到的结果返回到myMatches集合 107 ' For Each myMatch In myMatches '遍历myMatches集合 108 ' If myMatch <> "" Then 109 ' Debug.Print (classes(x)) 110 ' End If 111 ' Next 112 ' 113 ' End If 114 'Next 115 116 End Sub