VBA学习笔记(9)--生成点拨(1)

说明(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
原文地址:https://www.cnblogs.com/medik/p/10989743.html