在VB中遍历文件并用正则表达式完成复制

将"E:\my\汇报\成绩"路径下源文件中的“1项目”，“一项目”等文件复制到目标文件下。以下为实现方式。

Private Sub Option1_Click()
      Dim myStr As String
      '通过在单元格中输入项目序号,目前采用的InputBox方式指定的，也可通过此方式。二者取其一。
      'myStr = Sheets("Sheet1").Range("D21").Text
    
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '通过InputBox输入项目序号Start
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      myStr = InputBox("请输入项目序号，序号要为阿拉伯数字。格式一定要正确！格式如" & Chr(34) & "2项目" & Chr(34))
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '通过InputBox输入项目序号End
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      Dim endNum As Integer     'MID函数截取结束位数
      endNum = InStrRev(myStr, "项")
      myStr = Mid(myStr, 1, endNum - 1)
      'MsgBox myStr
      Dim CChinesStr As String
      CChineseStr = CChinese(myStr) '将阿拉伯数字转为汉字
      'MsgBox CChineseStr
      
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '遍历路径下的文件Start
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim fso As Object
        Dim folder As Object
        Dim subfolder As Object
        Dim file As Object
        Dim fileNameArray As String
        Dim basePath As String
        basePath = "E:\my\汇报\成绩"
        
        Set fso = CreateObject("scripting.filesystemobject") '创建FSO对象
        Set folder = fso.getfolder(basePath & "\源文件")
        
        For Each file In folder.Files '遍历根文件夹下的文件
        
        'fileNameArray = fileNameArray & file & "|"
                  Dim mRegExp As Object       '正则表达式对象
                  Dim mMatches As Object      '匹配字符串集合对象
                  Dim mMatch As Object        '匹配字符串
                  Set mRegExp = CreateObject("Vbscript.Regexp")
                  With mRegExp
                     .Global = True                              'True表示匹配所有, False表示仅匹配第一个符合项
                     .IgnoreCase = True                          'True表示不区分大小写, False表示区分大小写
                     '.Pattern = "([0-9])?[.]([0-9])+|([0-9])+"   '匹配字符模式
                     '.Pattern = "((([0-9]+)?)|(([一二三四五六七八九十]+)?))项目(([一二三四五六七八九十]+)?)|([0-9])?"   '匹配字符模式
                     '.Pattern = "(项目(二百三十四)+)|(((234)?|(二百三十四)?)项目(234)?)"   '匹配字符模式
                     '.Pattern = "(((" & "+)?)|(([一二三四五六七八九十]+)?))项目(([一二三四五六七八九十]+)?)|([0-9])?" '匹配字符模式
                      .Pattern = "(项目(" & CChineseStr & ")+)|(((" & myStr & ")?|(" & CChineseStr & ")?)项目(" & myStr & ")?)"   '匹配字符模式
                   
                     'Set mMatches = .Execute(Sheets("上报").Range("D21").Text)     '执行正则查找，返回所有匹配结果的集合，若未找到，则为空
                     
                     Set mMatches = .Execute(file)     '执行正则查找，返回所有匹配结果的集合，若未找到，则为空
                     For Each mMatch In mMatches
                         'SumValueInText = SumValueInText + CDbl(mMatch.Value)
                         'SumValueInText = SumValueInText & mMatch.Value
                         If mMatch.Value <> "" Then
                           'fileNameArray = fileNameArray & mMatch.Value & "_"
                            fso.copyfile basePath & "\源文件\" & mMatch.Value & ".*", basePath & "\目标文件" & myStr '复制操作
                         End If
                          
                    Next
                    
                 End With
                 'MsgBox fileNameArray
            
                 Set mRegExp = Nothing
                 Set mMatches = Nothing
        
        Next
        Set fso = Nothing
        Set folder = Nothing
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '遍历路径下的文件End
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       MsgBox "操作完成"
     
End Sub
'将阿拉伯数字转为汉字
Private Function CChinese(StrEng As String) As String
'验证数据
If Not IsNumeric(StrEng) Then
If Trim(StrEng) <> "" Then MsgBox "无效的数字"
CChinese = ""
Exit Function
End If
'定义变量
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
'strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strEng2Ch = "零一二三四五六七八九十"
'strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh1 = " 十百千 十百千 十百千 十百千"
strSeqCh2 = " 万亿兆"
'转换为表示数值的字符串
StrEng = CStr(CDec(StrEng))
'记录数字的长度
intLen = Len(StrEng)
'转换为汉字
For intCounter = 1 To intLen
'返回数字对应的汉字
strTempCh = Mid(strEng2Ch, Mid(StrEng, intCounter, 1) + 1, 1)
'若某位是零
If strTempCh = "零" And intLen <> 1 Then
'若后一个也是零，或零出现在倒数第1、5、9、13等位，则不显示汉字“零”
If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then strTempCh = ""
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
End If
'对于出现在倒数第1、5、9、13等位的数字
If (intLen - intCounter + 1) Mod 4 = 1 Then

'添加位" 万亿兆"
strTempCh = strTempCh & Trim(Mid(strSeqCh2, (intLen - intCounter) \ 4 + 1, 1))
End If
'组成汉字表达式
strCh = strCh & Trim(strTempCh)
Next
CChinese = strCh
End Function