在VB中遍歷文件並用正則表達式完成複製及vb實現重命名、拷貝文件夾的方法

這篇文章主要介紹了在VB中遍歷文件並用正則表達式完成複製及vb實現重命名、拷貝文件夾的方法,需要的朋友可以參考下

先看下在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

補充：下面看下用VB實現重命名、拷貝文件夾及文件

Private Sub commandButton1_Click()

'聲明文件夾名和路徑
Dim FileName, Path As String, EmptySheet As String
'Path = “D:\上報”
Path = InputBox(“請輸入” & Chr(34) & “成績” & Chr(34) & “文件夾的路徑，格式如” & Chr(34) & “D:\成績” & Chr(34))
FileName = Path & “\上學期”
EmptySheet = Path & “\學期初始化”
'MsgBox FileName
If Dir(FileName, vbDirectory) <> “” Then
'MsgBox “文件夾存在”
'獲取系統當前時間
'Dim dd As Date
'dd = Now
'MsgBox Format(dd, “yyyymm”)
Dim myTime As String
myTime = InputBox(“請輸入當前時間，格式如” & Chr(34) & “201811” & Chr(34))
If myTime = “” Then
MsgBox “當前時間不能爲空！否則不能重命名當期文件夾”
Else:
Name FileName As Path & “” & myTime
End If
End If
'判斷文件夾是否存在
If Dir(FileName, vbDirectory) = “” Then
'創建文件夾
MkDir (FileName)
'MsgBox (“創建完畢”)
Else: MsgBox (“文件夾已在”)
End If
'複製空表到當期
Set Fso = CreateObject(“Scripting.FileSystemObject”)
'拷貝文件夾
Fso.copyfolder EmptySheet, FileName
'Fso.copyfile EmptySheet&“c:*.*”, “d:” '拷貝文件
'FileSystemObject.copyfolder EmptySheet, FileName, 1
MsgBox (“操作成功！”)
End Sub

總結

以上所述是小編給大家介紹的在VB中遍歷文件並用正則表達式完成複製及vb實現重命名、拷貝文件夾的方法，希望對大家有所幫助，如果大家有任何疑問請給我留言，小編會及時回覆大家的。在此也非常感謝大家對神馬文庫網站的支持！