vba输出txt为ansi，如何批量输出为utf-8

tifaff

我有一段vba代码，功能是把表格里面多个单元格内容输出到对应多个txt里面（这个是没问题的），但因为内容含有汉字和其他特殊符号，vba默认输出ansi格式txt的话，该txt内容无法被我其他后续软件处理识别，所以请高手帮忙写一段vba输出txt为utf-8的，百度包括在这里搜索到很多相关的教程，但我小白，简单的代码拼接和套用下没有效果（有的代码只能输出为一个txt，我的是需要大量输出的，见代码附件，也可以看下面的，谢谢！
代码.rar (735 Bytes, 下载次数: 5)

2018-9-24 16:09 上传

点击文件名下载附件

=====================================================
Sub 导出()

Application.ScreenUpdating = False

n = Range("a65536").End(xlUp).Row '检测A列总行数

arr = Range("a2:i" & n) '存到数组，提升速度

For i = 1 To n - 1 '循环输出

outstr = ""

    sname = arr(i, 1)
    outstr = "我与" & arr(i, 1) & "的世界"      '没有注释

    If Len(arr(i, 2)) > 0 Then     '如果内容不是为空的话，就组合内容
    outstr = outstr & vbCrLf & vbCrLf & "提问" & arr(i, 2) & "解答"   'vbCrLf 是换行的意思
    End If

    If Len(arr(i, 3)) > 0 Then
    outstr = outstr & vbCrLf & vbCrLf & "小明" & arr(i, 3) & "个棉花糖"
    End If

    If Len(arr(i, 4)) > 0 Then
    outstr = outstr & vbCrLf & vbCrLf & "小四" & arr(i, 4) & "个棉花糖"
    End If

    If Len(arr(i, 5)) > 0 Then
    outstr = outstr & vbCrLf & vbCrLf & "小六" & arr(i, 5) & "个棉花糖"
    End If

    If Len(arr(i, 6)) > 0 Then
    outstr = outstr & vbCrLf & vbCrLf & "小五" & arr(i, 6) & "个棉花糖"
    End If


    If Len(arr(i, 7)) > 0 Then
    outstr = outstr & vbCrLf & vbCrLf & "换成" & arr(i, 7) & "西瓜"
    End If

    If Len(arr(i, 7)) > 0 Then
    outstr = outstr & vbCrLf & vbCrLf & "购买" & arr(i, 7) & "苹果"
    End If

    outstr = outstr & vbCrLf & "约定"

    outstr = outstr & vbCrLf & "签名"

    FullName = ThisWorkbook.Path & "\" & sname & ".txt"

    Open FullName For Output As #1

    Print #1, outstr;
    Close #1

Next

Application.ScreenUpdating = True

MsgBox "导出完毕"


End Sub


=====================================================

duquancai

用  CreateObject(Adodb.Stream)

ww87725244

借用 百度不到去谷歌 的代码

1. Public Function ReadUTF8(ByVal sUTF8File As String) As String
   
2.      If Len(sUTF8File) = 0 Or Dir(sUTF8File) = vbNullString Then Exit Function
   
3.      Dim ados As Object
   
4.      Set ados = CreateObject("adodb.stream")
   
5.      With ados
   
6.          .Charset = "utf-8"
   
7.          .Type = 2
   
8.          .Open
   
9.          .LoadFromFile sUTF8File
   
10.          ReadUTF8 = .ReadText
    
11.          .Close
    
12.      End With
    
13.      Set ados = Nothing
    
14. End Function

复制代码

ddmc

Sub FrSave1(文件 As String, s As String, Optional 编码 As String = "UTF-8")
'保存 字符串S  到文件
'参数：文件: 文件名称,
'     s:  frx 模板字符串 ,
'     编码 As String '编码举例 - "gb2312"、"UTF-8"等 默认"UTF-8"

Dim ObjStream As Object
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
    .Mode = 3         'adModeReadWrite = 3 ' 指示读/写权限。
    .Type = 2        'adTypeBinary = 2
     .CharSet = 编码 '编码举例 - "gb2312"、"UTF-8"等
    .Open
  .WriteText s
    .Position = 0
     .SaveToFile 文件, 2
     .Flush
    .Close               '关闭 对象
End With
Set ObjStream = Nothing  '清除对象
End Sub

tifaff

ww87725244 发表于 2018-9-24 16:55
借用 百度不到去谷歌 的代码

谢谢
但我是小白，我把你的代码放在我的代码之后或之前都无效，插入在中间也不行，请问该如何使用这段代码？

tifaff

ddmc 发表于 2018-9-24 19:22
Sub FrSave1(文件 As String, s As String, Optional 编码 As String = "UTF-8")
'保存 字符串S  到文件
...

谢谢  但情况和上面的一样 我想应该是我插入地方不对 或是需要修改一些对应参数名 我小白 能不能再详细说明一下？

tifaff

http://club.excelhome.net/thread-1070059-1-1.html
https://wenku.baidu.com/view/009a54c7dd3383c4ba4cd267.html
https://bbs.csdn.net/topics/40178051
https://stackoverflow.com/questions/1072075/how-do-i-call-a-vba-function-into-a-sub-procedure

找了很多资料，上面是其中几个指导在sub里面调用function的方法，4种形式
（1-call 函数名 2-直接fun函数名 3-fun() 4-Application.函数名 大部分人说不用带参数）
但是我情况是插入调用后无论带参数或不带都是提示
“参数不可选”    “缺少列表分隔符 或 )”   “对象不支持该属性或方法”
（我的参数只是copy两位指导的 小白不懂应该怎么改）


是不是真的要把“入门基础”这本书全部看完才能做好？ 菜鸟入门那里关键字搜索也只提到call调用

ddmc

tifaff 发表于 2018-9-25 02:41
http://club.excelhome.net/thread-1070059-1-1.html
https://wenku.baidu.com/view/009a54c7dd3383c4ba4c ...

把“入门基础”这本书全部看完,
至少 搞明白  自定义函数，过程 ，参数 传递。