- Dim str, fso, file, f, txt, m
-
- str = "零一二三四五六七八九十百千"
- Set fso = CreateObject("Scripting.FileSystemObject")
-
- For Each file In fso.GetFolder(".").Files
- If LCase(Right(file, 4)) = ".txt" Then
- Set f = fso.OpenTextFile(file, 1)
- txt = f.ReadAll + vbCrLf
- f.Close
- txt = DelBlankLine(txt) '删除空白行
- m = Split(txt, vbCrLf)
- m(0) = ConvertToNumber(m(0)) '转换第一行数字
- Set f = fso.OpenTextFile(file, 2)
- f.Write Join(m, vbCrLf) '重新写入文本
- f.Close : Set f = Nothing
- Rem 重命名
- If Not fso.FileExists(m(0) + ".txt") Then fso.GetFile(file).Name = m(0) + ".txt"
- End If
- Next
-
- Set fso = Nothing
- MsgBox "OK"
-
- function DelBlankLine(s)
- Dim reg
- Set reg = New RegExp
- reg.Pattern = "^[ ]*\r\n"
- reg.Global = True
- reg.MultiLine = True
- DelBlankLine = reg.Replace(s, "")
- End function
-
- Function ConvertToNumber(s)
- Dim re, s1, s2, i, chr, ss
- Set re = New RegExp
- re.Pattern = "^[\s ]*第([" & str & "〇两廿]+)章(?:节|[\s ]*([^\s ]*))[\s ]*$"
- If Not re.Test(s) Then ConvertToNumber = s : Exit Function
-
- s1 = re.Execute(s)(0).SubMatches(0)
- s2 = re.Execute(s)(0).SubMatches(1)
-
- s1 = Replace(s1, "〇", "零") : s1 = Replace(s1, "两", "二") : s1 = Replace(s1, "廿", "二十")
- If Left(s1, 1) = "十" Then s1 = "一" & s1
- For i = 1 to Len(s1)
- chr = Mid(s1, i, 1)
- If InStr(str, chr) > 10 Then
- ss = ss & "*10^" & (InStr(str, chr)-10) & "+"
- Else
- ss = ss & (InStr(str, chr)-1)
- End If
- Next
- s1 = Right("0000" & eval(ss & "+0"), 4)
- If s2 <> "" Then s2 = " " + s2
-
- ConvertToNumber = "第" + s1 + "章" + s2
- End Function
复制代码
|