利用VBA在WORD在GBK字符集中进行繁简转换——非BIG5转成GB2312

公司需要开发一套ASP.NET的繁体版本程序。
我们的机器都是简体的，当时为了方便就直接用了“微软拼音输入法”输入繁体，然后在web.config里设置globalization节为utf-8，这样我们就可以在简体机器里开发“繁体”的程序了，当然这时候这些繁体字符集的编码就不是BIG5了，但是，没有问题，用户看到的界面是繁体的就可以了。
后来，有另外一个部门也要用这样的程序不过要求必须转为简体版本，[$%#%^%&^%& 真是不得安生，用户就是上帝，我们只好转成简体了]，这时候用“Big5GB.exe”或者是“ConvertZ.exe”转出来的是乱码，没办法还是得用回MS的东西。
WORD里刚好有一个功能就是繁简转换的。只好用VBA写了点代码来转了。


如果哪位也碰到这么**的需求的时候也许用得着


文件下载 http://files.cnblogs.com/suxvsheng/change.zip

使用方法：



或者直接复制下面的代码到word里建立宏，在运行 main 就可以了，不过目录要改成你需要的
---------------------------------------------------------------------------------------------------------
Sub main()
    useFilePath = ActiveDocument.Path + "\" + ActiveDocument.Name
    sourceDir = "E:\job\JobDotNet\CFTS\CFTSBig\V1.0HK\UserControl\"
    aimDir = "E:\job\JobDotNet\CFTS\CFTSgz\temp\"
    searchFileType = "*.ascx"
   
    filePath = Dir(sourceDir + searchFileType)
    While filePath <> ""
        docEmpty
        fileOpen (sourceDir + filePath)
        tradition2Simple
        fileSave (aimDir + filePath)
        filePath = Dir()
    Wend
    docEmpty
    fileOpen (useFilePath)
    docEmpty
    fileSaveAs (useFilePath)
End Sub

Sub fileOpen(filePath)
    Open filePath For Input As #1
     While Not EOF(1)
        Line Input #1, lineTxt
        If Trim(lineTxt) <> "" Then
           Selection.TypeText Text:=lineTxt + vbCrLf
        End If
     Wend
     Close #1
End Sub

Sub docEmpty()
    Selection.WholeStory
    Selection.TypeBackspace
End Sub

Sub tradition2Simple()
'
' tradition2Simple Macro
' ºêÔÚ 2006-9-6 ÓÉ susun ¼ÖÆ
'
    Selection.Range.TCSCConverter WdTCSCConverterDirection:= _
        wdTCSCConverterDirectionTCSC, CommonTerms:=True, UseVariants:=False
End Sub

Sub fileSaveChange(filePath)
'
' Macro1 Macro
' ºêÔÚ 2006-9-6 ÓÉ susun ¼ÖÆ
'
    ActiveDocument.SaveAs FileName:=filePath, FileFormat:= _
        wdFormatTextLineBreaks, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
End Sub

Sub fileSaveAs(filePath)
ActiveDocument.SaveAs FileName:=filePath, FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
End Sub

----------------------------------------------------------------------------------------------------------