先看在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) ThenIf Trim(StrEng) <> “” Then MsgBox “無效的數字”CChinese = “”Exit FunctionEnd If'定義變數Dim intLen As Integer, intCounter As IntegerDim strCh As String, strTempCh As StringDim strSeqCh1 As String, strSeqCh2 As StringDim strEng2Ch As String'strstr.22 = 「零一二三四五六七八九十」'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 = “”ElsestrTempCh = 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)NextCChinese = strChEnd 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 FileNameIf Dir(FileName, vbDirectory) <> “” Then'MsgBox “資料夾存在”'取得系統目前時間'Dim dd As Date'dd = Now' MsgBox Format(dd, “yyyymm”)Dim myTime As StringmyTime = InputBox(“請輸入目前時間，格式如” & Chr(34) & “201811” & Chr(34))If myTime = “” ThenMsgBox “當前時間不能為空！否則不能重命名當期資料夾”Else:Name FileName As Path & “” & myTimeEnd IfEnd 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, 1MsgBox (“操作成功！”)End Sub
總結
以上所述是小編給大家介紹的在VB中遍歷文件並用正則表達式完成複製及vb實現重命名、拷貝文件夾的方法，希望對大家有所幫助，如果大家有任何疑問請給我留言，小編會及時回覆大家的。在此也非常感謝大家對武林網網站的支持！