[已解决]VBA更改txt文件“编码格式”为UTF-8？18楼附答谢文件

卧美吻花

刚刚切换操作系统到WinXP SP2，Office版本是2003（11.8105.8107）SP2

运行程序，结果跟11楼是一样的

这一句是不是写错了？

我不知道该怎么改啊！

[此贴子已经被作者于2006-11-7 22:29:48编辑过]

northwolves

你需要引用 ADO对象：

ADO   (ActiveX   Data   Objects)，Microsoft   ActiveX   Data   Objects   Library，其“引用”名为：Microsoft   ActiveX   Data   Objects   2.x   Library    

huyongapple

OpenAsTextStream 方法

请参阅

Copy 方法 | CreateTextFile 方法 | Delete 方法 | Move 方法 | OpenTextFile 方法
应用于：File 对象

语言

• JScript
  
• VBScript
  
• 显示所有语言

打开指定的文件并返回一个 TextStream 对象，可以通过这个对象对文件进行读、写或追加。

object.OpenAsTextStream([iomode, [format]])

参数

object

必选项。应为 File 对象的名称。

iomode

可选项。指明输入/输出的模式。可以是三个常数之一： ForReading 、 ForWriting 或 ForAppending 。

format

可选项。使用三态值中的一个来指明打开文件的格式。如果忽略，文件将以 ASCII 格式打开。

设置

iomode 参数可以是下列设置中的任一种：

常数	值	描述
ForReading	1	以只读方式打开文件。不能写这个文件。
ForWriting	2	以写方式打开文件。如果存在同名的文件，那么它以前的内容将被覆盖。
ForAppending	8	打开文件并从文件末尾开始写。

format 参数可以是下列设置中的任一种：

常数	值	描述
TristateUseDefault	-2	使用系统默认值打开文件。
TristateTrue	-1	以 Unicode 方式打开文件。
TristateFalse	0	以 ASCII 方式打开文件。

说明

OpenAsTextStream 方法提供的功能和 FileSystemObject 的 OpenTextFile 方法一样。另外， OpenAsTextStream 方法可以用来写文件。

下面的代码说明了 OpenAsTextStream 方法的用法：

[VBScript]
Function TextStreamTest
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
   Dim fso, f, ts
   Set fso = CreateObject("Scripting.FileSystemObject")
   fso.CreateTextFile "test1.txt"   ' Create a file.
   Set f = fso.GetFile("test1.txt")
   Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
   ts.Write "Hello World"
   ts.Close
   Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
   TextStreamTest = ts.ReadLine
   ts.Close
End Function

在VBA中好象就只能用系统默认编码、Unicode、ASCII读写文件了。若用VS编写个辅助程序读写文件，就可以使用近百个代码页读写文件了。

卧美吻花

回13楼的北狼斑竹：

刚刚引用了ADO对象（引用了MSADO2.5，引用MSADO2.0后运行程序会报错），[em04]新手啊，您多包涵

现在运行程序不报错了，可是

程序生成的文件还是ANSI编码的

不是UTF-8[em06]

请问何解？

[此贴子已经被作者于2006-11-7 23:09:32编辑过]

卧美吻花

回14楼的苹果兄

您说的OpenAsTextStream 的方法我应该加在那个地方呢？我自己试了一下，不成功

对不起，偶确实太菜了[em04]

另外，Function 在VBA里应该怎样调用啊？

 

下面是我的代码，该如何修改？

Private Sub CommandButton1_Click()
   Application.ScreenUpdating = False
           For ii = 3 To 5000
            Cells(ii, 14).Select
            If ActiveCell.Value <> "" Then
               a = ii
            End If
          Next ii
    Dim FullName As String
    FullName = "d:\dbf\" & Cells(1, 1)
    FullName.OpenAsTextStream (8)   '这里应该如何设置？？
    For i = 1 To a
     Print #1, Cells(i, 14)
    Next i
    Close #1
Application.ScreenUpdating = ture
Range("B2").Select
End Sub

[此贴子已经被作者于2006-11-7 23:42:08编辑过]

huyongapple

从“FullName.OpenAsTextStream (8)   '这里应该如何设置？？”以下至“ Close #1”改为：

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fso, f, ts
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile FullName     ' Create a file.
    Set f = fso.GetFile(FullName)
    Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)     '以系统默认编码写入文件
    For i = 1 To a
        ts.write Cells(i, 14)
    Next i
    ts.Close

卧美吻花

使用苹果兄提供的代码，程序保存txt文件成功！！！

说谢谢太俗了，也不能表达我激动的心情

 

这里提供一个我做的小东西给大家玩玩吧，希望大家喜欢

这个东西是给GoogleEarth用的实用版的中国地标

已经精确到了乡镇一级

 

原来限制了上传大小为250K[em04]，只能分4卷了

 

XDPMEQpM.rar (159.51 KB, 下载次数: 261)

2006-11-8 00:42 上传

点击文件名下载附件
[在线等]怎样让VBA更改已有的txt文件“编码格式”为UTF-8？

GoogleEarth的下载地址：
http://dl.google.com/earth/GE4/GoogleEarthWin.exe

stanleypan

用API就可以解决.就象是内码转换一样的道理.

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 = 65001

Public Function UTF8_Encode(ByVal Text As String) As String
Dim sBuffer As String
Dim lLength As Long
   If Text <> "" Then
      lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, 0, 0, 0, 0)
      sBuffer = Space$(lLength)
      lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
      sBuffer = StrConv(sBuffer, vbUnicode)
      UTF8_Encode = Left$(sBuffer, lLength - 1)
   Else
      UTF8_Encode = ""
   End If
End Function

qdofficer

要村级的！
呵呵！卧斑竹在这里也是新手？

qdofficer

使用苹果兄的代码，我怎么就存不成utf-8呢？
卧兄可否把完整代码再贴一遍？