Vejamos primeiro como percorrer arquivos em VB e usar expressões regulares para completar a função de cópia
Copie "Projeto 1", "Projeto 1" e outros arquivos do arquivo de origem no caminho "E:/my/Report/Achievements" para o arquivo de destino. Veja como fazer isso.
Private Sub Option1_Click()Dim myStr As String' Ao inserir o número de série do item na célula, ele é especificado pelo método InputBox usado atualmente, e este método também pode ser usado. Escolha um dos dois. 'myStr = Sheets("Sheet1").Range("D21").Text ''''''''''''''''''''''''''' '''' ''''''''''''''''''''' 'Insira o número de série do projeto através do InputBox Start '''''''''''' ''''' ''''''''''''''''''''''''''''''''''' '' minhaStr = InputBox("Por favor, insira o número de série do projeto. O número de série deve ser algarismos arábicos. O formato deve estar correto! O formato é como " & Chr(34) & "2 itens" & Chr(34)) '''' '''''''' ''''''''''''''''''''''''''''''''''''''''' ' 'Insira o número de série do projeto através do InputBoxEnd ''''''''''''''''''''''''''''''''''''''' '''''''' ''''' Dim endNum As Integer 'A função MID intercepta o dígito final endNum = InStrRev(myStr, "item") myStr = Mid(myStr, 1, endNum - 1) 'MsgBox myStr Dim CChinesStr As String CChineseStr = CChinese(myStr ) 'Converter algarismos arábicos em caracteres chineses'MsgBox CChineseStr '''''''''''''''''''''''''''''' '''''''' '''''''''''''' 'Percorrer os arquivos no caminho Iniciar '''''''''''''''''' '''''''' ''''''''''''''''''''''''''' Dim fso As Object Dim pasta Como Objeto Dim subpasta Como Objeto Dim file As Object Dim fileNameArray As String Dim basePath As String basePath = "E:/my/report/achievements" Set fso = CreateObject("scripting.filesystemobject") 'Criar objeto FSO Definir pasta = fso.getfolder(basePath & "/arquivo de origem") Para cada arquivo em folder.Files 'Atravessar arquivos na pasta raiz' fileNameArray = fileNameArray & file & "|" Dim mRegExp As Object 'Objeto de expressão regular Dim mMatches As Object 'Corresponde ao objeto de coleção de strings Dim mMatch As Object 'Corresponde à string Set mRegExp = CreateObject("Vbscript.Regexp") With mRegExp .Global = True 'True significa combinar todos, False significa combinar apenas a primeira correspondência item.IgnoreCase = True 'True significa que não diferencia maiúsculas de minúsculas, False significa que diferencia maiúsculas de minúsculas'.Pattern = "([0-9])?[.]([0-9])+|([0-9])+" 'Corresponder padrão de caracteres'.Pattern = "((([0-9]+)? )|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9])?" 'Corresponder padrão de caractere'.Pattern = "(Item(234)+)|(((234)?|(Duzentos e trinta e quatro)?)Item(234))" 'Corresponder padrão de caracteres'.Pattern = "(((" & "+) ?)|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9 ])? " 'Corresponde ao padrão de caracteres.Pattern = "(item(" & CChineseStr & ")+)|(((" & myStr & ")?|(" & CChineseStr & ")?)item(" & myStr & ")?)" 'Corresponder padrão de caractere'Definir mMatches = .Execute(Sheets("Report").Range("D21").Text) 'Executa uma pesquisa regular e retorna um conjunto de todos os resultados correspondentes. Se não for encontrado, estará vazio Set mMatches =. .Execute(file) 'Execute a pesquisa regular e retorne o conjunto de todos os resultados correspondentes. Se não for encontrado, será vazio For Each mMatch In mMatches 'SumValueInText = SumValueInText + CDbl(mMatch.Value) 'SumValueInText = SumValueInText & mMatch. Valor If mMatch .Value <> "" Then 'fileNameArray = fileNameArray & mMatch.Value & "_" fso.copyfile basePath & "/arquivo de origem/" & mMatch.Value & ".*", basePath & "/arquivo de destino" & myStr 'Copiar operaçãoEnd If Next End With 'MsgBox fileNameArray Set mRegExp = Nada definido mMatches = Nada próximo conjunto fso = Nada Definir pasta = Nada '''''''''''''''''''''''''''''''' ''''''''' ''''''''' 'Percorra os arquivos sob o pathEnd '''''''''''''''''''''''''''''''' '''''''''' ''''''''' MsgBox "Operação concluída"End Sub'Converter algarismos arábicos em caracteres chinesesPrivate Function CChinese(StrEng As String) As String'Verificar dadosIf Not IsNumeric( StrEng) ThenIf Trim(StrEng) <> “” Then MsgBox “Número inválido”CChinês = “”Sair FunctionEnd If'define variável Dim intLen As Integer, intCounter As IntegerDim strCh As String, strTempCh As StringDim strSeqCh1 As String, strSeqCh2 As StringDim strEng2Ch As String'strEng2Ch = "zero um dois três quatro cinco terra sete sete oito nove" strEng2Ch = "zero um dois três quatro cinco seis sete oito noventa"'strSeqCh1 = " "strSeqCh1 = "Cem Mil Cem Cem Mil Cem Mil" strSeqCh2 = "Trillion"'Converta para uma string representando um valor numérico StrEng = CStr(CDec( StrEng))'Registre o comprimento do númerointLen = Len(StrEng )'Converter para caracteres chinesesFor intCounter = 1 To intLen'Retorna o caractere chinês correspondente ao número strTempCh = Mid(strEng2Ch, Mid(StrEng, intCounter, 1) + 1, 1)'Se um determinado bit for zero If strTempCh = "zero" And intLen <> 1 Then'If o último também é zero , ou zero aparece na 1ª, 5ª, 9ª, 13ª, etc. posições a partir da parte inferior, então o caractere chinês "zero" não será exibido. = “0” Ou (intLen - intCounter + 1) Mod 4 = 1 Then strTempCh = “”ElsestrTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))End If'Para a string que aparece no último 1, números com dígitos 5, 9, 13, etc. If (intLen - intCounter + 1) Mod 4 = 1 Então'Adicione o bit "Trillion" strTempCh = strTempCh & Trim(Mid(strSeqCh2, (intLen - intCounter) / 4 + 1, 1))End If' para formar uma expressão chinesa strCh = strCh & Trim(strTempCh)NextCChinese = strChEnd FunçãoSuplemento: vamos dar uma olhada em como usar VB para renomear e copiar pastas e arquivos.
Private Sub commandButton1_Click()'Declara o nome e o caminho da pasta Dim FileName, Path As String, EmptySheet As String'Path = "D:/Report" Path = InputBox("Por favor, insira" & Chr(34) & "Grade" & Chr ( 34) & “O caminho para a pasta, no formato de” & Chr(34) & “D:/notas” & Chr(34))FileName = Caminho & "/Last Semester"EmptySheet = Path & "/Semester Initialization"'MsgBox FileNameIf Dir(FileName, vbDirectory) <> ""Then'MsgBox "A pasta existe"'Obter a hora atual do sistema'Dim dd As Date'dd = Agora ' MsgBox Format(dd, “yyyymm”)Dim myTime As StringmyTime = InputBox(“Por favor, insira a hora atual no formato de” & Chr(34) & "201811" & Chr(34))If myTime = "" ThenMsgBox "A hora atual não pode estar vazia! Caso contrário, a pasta atual não pode ser renomeada"Else:Name FileName As Path & "" & myTimeEnd IfEnd If' Determine se a pasta existeIf Dir(FileName, vbDirectory) = "" Then'Create folder MkDir (FileName)'MsgBox ("Criado")Else: MsgBox ("A pasta já está lá")Fim If'Copia a tabela vazia para o atual Set Fso = CreateObject("Scripting.FileSystemObject")'Copia a pasta Fso.copyfolder EmptySheet, FileName'Fso.copyfile EmptySheet&"c:*. *", "d:" 'Copiar arquivo'FileSystemObject.copyfolder EmptySheet, FileName, 1MsgBox ("Operação bem-sucedida!")End SubResumir
O método acima é o método introduzido pelo editor para percorrer arquivos em VB e usar expressões regulares para copiar, renomear e copiar pastas em VB. Espero que seja útil para você. o editor responderá a todos a tempo. Também gostaria de agradecer a todos pelo apoio ao site Wulin.com!