Let’s first look at traversing files in VB and using regular expressions to complete the copy function
Copy "Project 1", "Project 1" and other files in the source file under the path "E:/my/Report/Achievements" to the target file. Here's how to do it.
Private Sub Option1_Click()Dim myStr As String' By entering the item serial number in the cell, it is specified by the InputBox method currently used, and this method can also be used. Choose one of the two. 'myStr = Sheets("Sheet1").Range("D21").Text '''''''''''''''''''''''''''' ''''''''''''''''''''''''''' 'Enter the project serial number through the InputBox Start '''''''''''' '''''''''''''''''''''''''''''''''''''''''' '' myStr = InputBox("Please enter the project serial number. The serial number must be Arabic numerals. The format must be correct! The format is such as " & Chr(34) & "2 items" & Chr(34)) '''''''''''' '''''''''''''''''''''''''''''''''''''''''' ' 'Enter the project serial number through the InputBoxEnd '''''''''''''''''''''''''''''''''''''''''' ''''''''''''' Dim endNum As Integer 'MID function intercepts the end digit endNum = InStrRev(myStr, "item") myStr = Mid(myStr, 1, endNum - 1) 'MsgBox myStr Dim CChinesStr As String CChineseStr = CChinese(myStr) 'Convert Arabic numerals to Chinese characters'MsgBox CChineseStr '''''''''''''''''''''''''''''''' ''''''''''''''''''''''' 'Traverse the files under the path 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/report/achievements" Set fso = CreateObject("scripting.filesystemobject") 'Create FSO object Set folder = fso.getfolder(basePath & "/source file") For Each file In folder.Files 'Traverse files under the root folder' fileNameArray = fileNameArray & file & "|" Dim mRegExp As Object 'Regular expression object Dim mMatches As Object 'Match string collection object Dim mMatch As Object 'Match string Set mRegExp = CreateObject("Vbscript.Regexp") With mRegExp .Global = True 'True means matching all, False means matching only The first matching item.IgnoreCase = True 'True means case-insensitive, False means case-sensitive'.Pattern = "([0-9])?[.]([0-9])+|([0-9])+" 'Match character pattern'.Pattern = "((([0-9]+)? )|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9])?" 'Match character pattern'.Pattern = "(Item(234)+)|(((234)?|(Two Hundred and Thirty-four)?)Item(234)?)" 'Match character pattern'.Pattern = "(((" & "+)?)|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9 ])?" 'Match character pattern.Pattern = "(item(" & CChineseStr & ")+)|(((" & myStr & ")?|(" & CChineseStr & ")?)item(" & myStr & ")?)" 'Match character pattern'Set mMatches = .Execute(Sheets("Report").Range("D21").Text) 'Execute regular search and return a set of all matching results. If not found, it will be empty Set mMatches = .Execute(file) 'Execute regular search and return the set of all matching results. If not found, it will be empty. 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 & "/source file/" & mMatch.Value & ".*", basePath & "/target file" & myStr 'Copy operationEnd If Next End With 'MsgBox fileNameArray Set mRegExp = Nothing Set mMatches = Nothing Next Set fso = Nothing Set folder = Nothing '''''''''''''''''''''''''''''''''' '''''''''''''''''' 'Traverse the files under the pathEnd ''''''''''''''''''''''''''''''''' ''''''''''''''''''' MsgBox "Operation completed"End Sub'Convert Arabic numerals to Chinese charactersPrivate Function CChinese(StrEng As String) As String'Verify dataIf Not IsNumeric( StrEng) ThenIf Trim(StrEng) <> “” Then MsgBox “Invalid number”CChinese = “”Exit FunctionEnd If'define variable Dim intLen As Integer, intCounter As IntegerDim strCh As String, strTempCh As StringDim strSeqCh1 As String, strSeqCh2 As StringDim strEng2Ch As String'strEng2Ch = "zero one two three four five land seven seven eight nine" strEng2Ch = "zero one two three four five six seven eight ninety"'strSeqCh1 = " "strSeqCh1 = "One Hundred Thousand One Hundred One Hundred Thousand One Hundred Thousand" strSeqCh2 = "Trillion"'Convert to a string representing a numerical value StrEng = CStr(CDec( StrEng))'Record the length of the numberintLen = Len(StrEng)'Convert to Chinese charactersFor intCounter = 1 To intLen'Returns the Chinese character corresponding to the number strTempCh = Mid(strEng2Ch, Mid(StrEng, intCounter, 1) + 1, 1)'If a certain bit is zero If strTempCh = "zero" And intLen <> 1 Then'If the latter one is also zero , or zero appears in the 1st, 5th, 9th, 13th, etc. positions from the bottom, then the Chinese character "zero" will not be displayed. 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'For the string that appears in the last 1, Numbers with digits of 5, 9, 13, etc. If (intLen - intCounter + 1) Mod 4 = 1 Then'Add the bit "Trillion" strTempCh = strTempCh & Trim(Mid(strSeqCh2, (intLen - intCounter) / 4 + 1, 1))End If' to form a Chinese expression strCh = strCh & Trim(strTempCh)NextCChinese = strChEnd Function
Supplement: Let’s take a look at how to use VB to rename and copy folders and files.
Private Sub commandButton1_Click()'Declare the folder name and path Dim FileName, Path As String, EmptySheet As String'Path = "D:/Report" Path = InputBox("Please enter" & Chr(34) & "Grade" & Chr( 34) & “The path to the folder, in the format of” & Chr(34) & “D:/grades” & Chr(34))FileName = Path & "/Last Semester"EmptySheet = Path & "/Semester Initialization"'MsgBox FileNameIf Dir(FileName, vbDirectory) <> ""Then'MsgBox "The folder exists"'Get the current system time'Dim dd As Date'dd = Now' MsgBox Format(dd, “yyyymm”)Dim myTime As StringmyTime = InputBox(“Please enter the current time in the format of” & Chr(34) & "201811" & Chr(34))If myTime = "" ThenMsgBox "The current time cannot be empty! Otherwise, the current folder cannot be renamed"Else:Name FileName As Path & "" & myTimeEnd IfEnd If' Determine whether the folder existsIf Dir(FileName, vbDirectory) = "" Then'Create folder MkDir (FileName)'MsgBox ("Created")Else: MsgBox ("The folder is already there")End If'Copy the empty table to the current Set Fso = CreateObject("Scripting.FileSystemObject")'Copy the folder Fso.copyfolder EmptySheet, FileName'Fso.copyfile EmptySheet&"c:*.*", "d:" 'Copy file'FileSystemObject.copyfolder EmptySheet, FileName, 1MsgBox ("Operation successful!")End Sub
Summarize
The above is the method introduced by the editor to traverse files in VB and use regular expressions to copy and rename and copy folders in VB. I hope it will be helpful to you. If you have any questions, please leave me a message. The editor will reply to everyone in time. I would also like to thank everyone for your support of the Wulin.com website!