先看下在VB中遍历文件并用正则表达式完成复制功能
将"E:\my\汇报\成绩"路径下源文件中的“1项目”，“一项目”等文件复制到目标文件下。以下为实现方式。
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
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'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 = “”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实现重命名、拷贝文件夹及文件
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
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实现重命名、拷贝文件夹的方法，希望对大家有所帮助，如果大家有任何疑问请给我留言，小编会及时回复大家的。在此也非常感谢大家对服务器之家网站的支持！
