在VB中遍历文件并用正则表达式完成复制及vb实现重命名、拷贝文件夹的方法
先看下在VB中遍历文件并用正则表达式完成复制功能
将"E:\my\汇报\成绩"路径下源文件中的“1项目”，“一项目”等文件复制到目标文件下。以下为实现方式。
PrivateSubOption1_Click()
DimmyStrAsString
'通过在单元格中输入项目序号,目前采用的InputBox方式指定的，也可通过此方式。二者取其一。
'myStr=Sheets(“Sheet1”).Range(“D21”).Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'通过InputBox输入项目序号Start
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
myStr=InputBox("请输入项目序号，序号要为阿拉伯数字。格式一定要正确！格式如"&Chr(34)&"2项目"&Chr(34))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'通过InputBox输入项目序号End
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DimendNumAsInteger'MID函数截取结束位数
endNum=InStrRev(myStr,"项")
myStr=Mid(myStr,1,endNum-1)
'MsgBoxmyStr
DimCChinesStrAsString
CChineseStr=CChinese(myStr)'将阿拉伯数字转为汉字
'MsgBoxCChineseStr
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历路径下的文件Start
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DimfsoAsObject
DimfolderAsObject
DimsubfolderAsObject
DimfileAsObject
DimfileNameArrayAsString
DimbasePathAsString
basePath="E:\my\汇报\成绩"
Setfso=CreateObject("scripting.filesystemobject")'创建FSO对象
Setfolder=fso.getfolder(basePath&"\源文件")
ForEachfileInfolder.Files'遍历根文件夹下的文件
'fileNameArray=fileNameArray&file&"|"
DimmRegExpAsObject'正则表达式对象
DimmMatchesAsObject'匹配字符串集合对象
DimmMatchAsObject'匹配字符串
SetmRegExp=CreateObject("Vbscript.Regexp")
WithmRegExp
.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&")?)"'匹配字符模式
'SetmMatches=.Execute(Sheets("上报").Range("D21").Text)'执行正则查找，返回所有匹配结果的集合，若未找到，则为空
SetmMatches=.Execute(file)'执行正则查找，返回所有匹配结果的集合，若未找到，则为空
ForEachmMatchInmMatches
'SumValueInText=SumValueInText+CDbl(mMatch.Value)
'SumValueInText=SumValueInText&mMatch.Value
IfmMatch.Value<>""Then
'fileNameArray=fileNameArray&mMatch.Value&"_"
fso.copyfilebasePath&"\源文件\"&mMatch.Value&".*",basePath&"\目标文件"&myStr'复制操作
EndIf
Next
EndWith
'MsgBoxfileNameArray
SetmRegExp=Nothing
SetmMatches=Nothing
Next
Setfso=Nothing
Setfolder=Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'遍历路径下的文件End
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MsgBox"操作完成"
EndSub
'将阿拉伯数字转为汉字
PrivateFunctionCChinese(StrEngAsString)AsString
'验证数据
IfNotIsNumeric(StrEng)Then
IfTrim(StrEng)<>“”ThenMsgBox“无效的数字”
CChinese=“”
ExitFunction
EndIf
'定义变量
DimintLenAsInteger,intCounterAsInteger
DimstrChAsString,strTempChAsString
DimstrSeqCh1AsString,strSeqCh2AsString
DimstrEng2ChAsString
'strEng2Ch=“零壹贰叁肆伍陆柒捌玖”
strEng2Ch=“零一二三四五六七八九十”
'strSeqCh1="拾佰仟拾佰仟拾佰仟拾佰仟"
strSeqCh1="十百千十百千十百千十百千"
strSeqCh2="万亿兆"
'转换为表示数值的字符串
StrEng=CStr(CDec(StrEng))
'记录数字的长度
intLen=Len(StrEng)
'转换为汉字
ForintCounter=1TointLen
'返回数字对应的汉字
strTempCh=Mid(strEng2Ch,Mid(StrEng,intCounter,1)+1,1)
'若某位是零
IfstrTempCh=“零”AndintLen<>1Then
'若后一个也是零，或零出现在倒数第1、5、9、13等位，则不显示汉字“零”
IfMid(StrEng,intCounter+1,1)=“0”Or(intLen-intCounter+1)Mod4=1ThenstrTempCh=“”
Else
strTempCh=strTempCh&Trim(Mid(strSeqCh1,intLen-intCounter+1,1))
EndIf
'对于出现在倒数第1、5、9、13等位的数字
If(intLen-intCounter+1)Mod4=1Then
'添加位"万亿兆"
strTempCh=strTempCh&Trim(Mid(strSeqCh2,(intLen-intCounter)\4+1,1))
EndIf
'组成汉字表达式
strCh=strCh&Trim(strTempCh)
Next
CChinese=strCh
EndFunction
补充：下面看下用VB实现重命名、拷贝文件夹及文件
PrivateSubcommandButton1_Click() '声明文件夹名和路径 DimFileName,PathAsString,EmptySheetAsString 'Path=“D:\上报” Path=InputBox(“请输入”&Chr(34)&“成绩”&Chr(34)&“文件夹的路径，格式如”&Chr(34)&“D:\成绩”&Chr(34)) FileName=Path&“\上学期” EmptySheet=Path&“\学期初始化” 'MsgBoxFileName IfDir(FileName,vbDirectory)<>“”Then 'MsgBox“文件夹存在” '获取系统当前时间 'DimddAsDate 'dd=Now 'MsgBoxFormat(dd,“yyyymm”) DimmyTimeAsString myTime=InputBox(“请输入当前时间，格式如”&Chr(34)&“201811”&Chr(34)) IfmyTime=“”Then MsgBox“当前时间不能为空！否则不能重命名当期文件夹” Else: NameFileNameAsPath&“”&myTime EndIf EndIf '判断文件夹是否存在 IfDir(FileName,vbDirectory)=“”Then '创建文件夹 MkDir(FileName) 'MsgBox(“创建完毕”) Else:MsgBox(“文件夹已在”) EndIf '复制空表到当期 SetFso=CreateObject(“Scripting.FileSystemObject”) '拷贝文件夹 Fso.copyfolderEmptySheet,FileName 'Fso.copyfileEmptySheet&“c:*.*”,“d:”'拷贝文件 'FileSystemObject.copyfolderEmptySheet,FileName,1 MsgBox(“操作成功！”) EndSub
总结
以上所述是小编给大家介绍的在VB中遍历文件并用正则表达式完成复制及vb实现重命名、拷贝文件夹的方法，希望对大家有所帮助，如果大家有任何疑问请给我留言，小编会及时回复大家的。在此也非常感谢大家对毛票票网站的支持！