• 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
  • 相关阅读:
    对于GetBuffer() 与 ReleaseBuffer() 的一些分析
    _tmain与main,winMain,wmain收藏
    【引用】常用字符串长度计算函数
    Invalid URI
    Cannot obtain the schema rowset "DBSCHEMA_TABLES_INFO" for OLE DB provider "SQLNCLI10" for linked server "DB1".
    Penang Industrial Zone
    Create Raid 1 and Raid 10 in one server
    Time zone BOGUS not found in registry
    'xxx_Forms' is not a valid Application Database or User 'sa' does not have sufficient permissions to check
    Syteline Goods Receiving Note Report
  • 原文地址:https://www.cnblogs.com/medik/p/10989743.html
Copyright © 2020-2023  润新知