VBA:文本文件编码互换
2016-02-21 00:00
701 查看
I'm using this script to convert any character set or code page (that i'm aware of).
This script can also handle large files (over one gigabytes), because it streams one line at a time.
This script can also handle large files (over one gigabytes), because it streams one line at a time.
' - ConvertCharset.vbs - ' ' Inspired by: ' http://www.vbforums.com/showthread.php?533879-Generate-text-files-in-IBM-850-encoding ' http://stackoverflow.com/questions/5182102/vb6-vbscript-change-file-encoding-to-ansii/5186170#5186170 ' http://stackoverflow.com/questions/13130214/how-to-convert-a-batch-file-stored-in-utf-8-to-something-that-works-via-another ' ' Start Main Function ConvertCharset Dim objArguments Dim strSyntaxtext, strInputCharset, strOutputCharset, strInputFile, strOutputFile Dim intReadPosition, intWritePosition Dim arrCharsets Const adReadAll = -1 Const adReadLine = -2 Const adSaveCreateOverWrite = 2 Const adSaveCreateNotExist = 1 Const adTypeBinary = 1 Const adTypeText = 2 Const adWriteChar = 0 Const adWriteLine = 1 strSyntaxtext = strSyntaxtext & "Converts the charset of the input text file to output file." & vbCrLf strSyntaxtext = strSyntaxtext & "Syntax: " & vbCrLf strSyntaxtext = strSyntaxtext & WScript.ScriptName & " /InputCharset:utf-8|windows-1252|ibm850|..." & vbCrLf strSyntaxtext = strSyntaxtext & " /OutputCharset:utf-8|windows-1252|ibm850|..." & vbCrLf strSyntaxtext = strSyntaxtext & " /InputFile:\\path\to\inputfile.ext" & vbCrLf strSyntaxtext = strSyntaxtext & " /OutputFile:\\path\to\outputfile.ext" & vbCrLf strSyntaxtext = strSyntaxtext & " [/ShowAllCharSets]" & vbCrLf & vbCrLf strSyntaxtext = strSyntaxtext & "Example:" & vbCrLf strSyntaxtext = strSyntaxtext & WScript.ScriptName & " /InputCharset:ibm850 /OutputCharset:utf-8 /InputFile:my_dos.txt /OutputFile:my_utf-8.txt" & vbCrLf Set objArgumentsNamed = WScript.Arguments.Named If objArgumentsNamed.Count = 0 Then WScript.Echo strSyntaxtext WScript.Quit(99) End If arrCharsets = Split("big5,big5-hkscs,euc-jp,euc-kr,gb18030,gb2312,gbk,ibm-thai," &_ "ibm00858,ibm01140,ibm01141,ibm01142,ibm01143,ibm01144," &_ "ibm01145,ibm01146,ibm01147,ibm01148,ibm01149,ibm037," &_ "ibm1026,ibm273,ibm277,ibm278,ibm280,ibm284,ibm285,ibm297," &_ "ibm420,ibm424,ibm437,ibm500,ibm775,ibm850,ibm852,ibm855," &_ "ibm857,ibm860,ibm861,ibm862,ibm863,ibm864,ibm865,ibm866," &_ "ibm869,ibm870,ibm871,iso-2022-jp,iso-2022-kr,iso-8859-1," &_ "iso-8859-13,iso-8859-15,iso-8859-2,iso-8859-3,iso-8859-4," &_ "iso-8859-5,iso-8859-6,iso-8859-7,iso-8859-8,iso-8859-9," &_ "koi8-r,koi8-u,shift_jis,tis-620,us-ascii,utf-16,utf-16be," &_ "utf-16le,utf-7,utf-8,windows-1250,windows-1251,windows-1252," &_ "windows-1253,windows-1254,windows-1255,windows-1256," &_ "windows-1257,windows-1258,unicode", ",") Set objFileSystem = CreateObject("Scripting.FileSystemObject") For Each objArgumentNamed in objArgumentsNamed Select Case Lcase(objArgumentNamed) Case "inputcharset" strInputCharset = LCase(objArgumentsNamed(objArgumentNamed)) If Not IsCharset(strInputCharset) Then WScript.Echo "The InputCharset (" & strInputCharset & ") is not valid, quitting. The valid charsets are:" & vbCrLf x = ShowCharsets() WScript.Quit(1) End If Case "outputcharset" strOutputCharset = LCase(objArgumentsNamed(objArgumentNamed)) If Not IsCharset(strOutputCharset) Then WScript.Echo "The strOutputCharset (" & strOutputCharset & ") is not valid, quitting. The valid charsets are:" & vbCrLf x = ShowCharsets() WScript.Quit(2) End If Case "inputfile" strInputFile = LCase(objArgumentsNamed(objArgumentNamed)) If Not objFileSystem.FileExists(strInputFile) Then WScript.Echo "The InputFile (" & strInputFile & ") does not exist, quitting." & vbCrLf WScript.Quit(3) End If Case "outputfile" strOutputFile = LCase(objArgumentsNamed(objArgumentNamed)) If objFileSystem.FileExists(strOutputFile) Then WScript.Echo "The OutputFile (" & strOutputFile & ") exists, quitting." & vbCrLf WScript.Quit(4) End If Case "showallcharsets" x = ShowCharsets() Case Else WScript.Echo "Unknown parameter, quitting: /" & objArgumentNamed & ":" & objArgumentsNamed(objArgumentNamed) WScript.Echo strSyntaxtext End Select Next If Len(strInputCharset) > 0 And Len(strOutputCharset) > 0 And Len(strInputFile) > 0 And Len(strOutputFile) Then Set objInputStream = CreateObject("ADODB.Stream") Set objOutputStream = CreateObject("ADODB.Stream") With objInputStream .Open .Type = adTypeBinary .LoadFromFile strInputFile .Type = adTypeText .Charset = strInputCharset intWritePosition = 0 objOutputStream.Open objOutputStream.Charset = strOutputCharset Do While .EOS <> True strText = .ReadText(adReadLine) objOutputStream.WriteText strText, adWriteLine Loop .Close End With objOutputStream.SaveToFile strOutputFile , adSaveCreateNotExist objOutputStream.Close WScript.Echo "The " & objFileSystem.GetFileName(strInputFile) & " was converted to " & objFileSystem.GetFileName(strOutputFile) & " OK." End If ' End Main ' Start Functions Function IsCharset(strMyCharset) IsCharset = False For Each strCharset in arrCharsets If strCharset = strMyCharset Then IsCharset = True Exit For End If Next End Function Function ShowCharsets() strDisplayCharsets = "" intCounter = 0 For Each strcharset in arrCharsets intCounter = intCounter + Len(strcharset) + 1 strDisplayCharsets = strDisplayCharsets & strcharset & "," If intCounter > 67 Then intCounter = 0 strDisplayCharsets = strDisplayCharsets & vbCrLf End If Next strDisplayCharsets = Mid(strDisplayCharsets, 1, Len(strDisplayCharsets)-1) WScript.Echo strDisplayCharsets End Function ' End Functions
相关文章推荐
- Outlook 批量发送邮件
- VBA将excel数据表生成JSON文件
- excel vba 限制工作表的滚动区域代码
- VBA解决Windows空当接龙的617局
- excel vba 高亮显示当前行代码
- 用VBScript写合并文本文件的脚本
- CMD命令行将当前磁盘所有文件名写入到文本文件的方法
- VBA中连接SQLSERVER数据库例子
- C#读写文本文件的方法
- 使用VBS访问外部文本文件一些方法和脚本实例代码
- VBS文本文件操作实现代码
- C#处理文本文件TXT实例详解
- 文本文件编码方式区别
- C语言中使用lex统计文本文件字符数
- C#实现获取文本文件的编码的一个类(区分GB2312和UTF8)
- php删除文本文件中重复行的方法
- 效率较高的php下读取文本文件的代码[原创]_php技巧_脚本之家
- Asp.Net中的字符串和HTML十进制编码转换实现代码
- C#读取文本文件到listbox组件的方法
- JS 文件本身编码转换 图文教程