rem 本程序可以转换小于10M之内的文件,亲自测试速度还可以
on error resume next
Set WshShell=WScript.CreateObject("Shell.Application")
'dirPath=WshShell.BrowseForFolder(0, "请选择路径", 0, "").items().item().path
'outpath=WshShell.BrowseForFolder(0, "请选择输出路径", 0, "").items().item().path
dirPath=inputbox("请输入要转换的文件路径")
outpath=inputbox("请输入转换后的文件路径")
if right(dirPath,1)<>"\" then dirPath=dirpath&"\"
if right(outPath,1)<>"\" then outPath=outpath&"\"
ma=inputbox("请输入要转换为的编码","","Unicode")
'msg=msgbox("在使用前请确认已备份文件夹"&dirPath,1)
if ma="" or dirPath="\" then WScript.Quit
'遍历文件夹下的文件
Set FSO = CreateObject("scripting.filesystemobject")
Set f = FSO.GetFolder(dirPath)
Set fs = f.files
For Each fileN in fs
FN=dirPath&fileN.name&""
if ".csv"=lcase(right(FN,4)) then Call WriteToFile(FN, ReadFile(FN, CheckCode(FN)), ma)
Next
Set FSO = Nothing
wscript.echo "全部成功"
msgbox "结束"
'检测文件的编码
Function CheckCode (FileUrl)
Dim slz
set slz = CreateObject("Adodb.Stream")
slz.Type = 1
slz.Mode = 3
slz.Open
slz.Position = 0
slz.Loadfromfile FileUrl
Bin=slz.read(2)
if AscB(MidB(Bin,1,1))=&HEF and AscB(MidB(Bin,2,1))=&HBB Then
Codes="UTF-8"
elseif AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
Codes="Unicode"
else
Codes="GB2312"
end if
slz.Close
set slz = Nothing
CheckCode=Codes
End Function
'以指定的编码读取文件
Function ReadFile(FileUrl, CharSet)
On Error Resume Next
Dim Str
Set stm = CreateObject("Adodb.Stream")
stm.Type = 2
stm.mode = 3
stm.charset = CharSet
stm.Open
stm.loadfromfile FileUrl
Str = stm.readtext '此处比较耗时
stm.Close
Set stm = Nothing
wscript.echo "正在转换:"& FileUrl
'msgbox FileUrl.name
'wscript.echo Str
ReadFile = Str
End Function
'以指定的编码写文件
Function WriteToFile (FileUrl, Str, CharSet)
On Error Resume Next
FileUrl = Mid(fileurl, InStrRev(fileurl,"\")+1,Len(fileurl)-InStrRev(fileurl,"\")+1)
tagpath= outpath + FileUrl
'msgbox tagpath
Set stm = CreateObject("Adodb.Stream")
stm.Type = 2
stm.mode = 3
stm.charset = CharSet
stm.Open
stm.WriteText Str
stm.SaveToFile tagpath, 2
stm.flush
stm.Close
Set stm = Nothing
End Function