ワークシートをUTF-8のテキストファイルとしてエクスポートする方法

質問

ワークシートをUTF-8のテキストファイルとしてエクスポートする方法

こんにちは。VBA初心者です。

このサイトで質問しながら、以下のようなコードを書いてみました。
しかし最後の（3）の手順でS-JISになってしまうので、UTF-8で読み込んだ意味がなくなってしまいます。

このページ「http://msdn.microsoft.com/ja-jp/library/cc408235.aspx」を見て、ADODB.StreamのWriteTextを使えばいいのかなとも思いましたが、どうやら違うみたいです（というか使い方がよく理解できないです）。

読み込みから出力までUTF-8で行うにはどうしたらよいでしょうか。
どうかよろしくお願いします。

下記のコードの処理内容：

1）ADODB.Streamを使用してUTF-8のテキストを新規ワークシートにインポート（同時に「//」でコメントアウトされた行を削除

2）ダミー文字挿入()プロシージャで「@:TEXT_」で始まる行以下に2行連続して空行があった場合は、[dummy]という文字列を挿入

3）Openステートメントでテキストファイルを作成し、そこにWriteステートメントでワークシート内のテキストを書き込む

Sub test()

Dim mystream As Object
Dim i As Long
Dim tempText As String
Dim myFileNo As Integer
Const adTypetext As Long = 2
Const adReadLine As Long = -2

Set mystream = CreateObject("ADODB.Stream")

With mystream
.Type = adTypetext
.Charset = "UTF-8"
.Open
.LoadFromFile ("D:\test\sample.txt")
End With

Worksheets.Add after:=Worksheets(Worksheets.Count)

i = 1

Do Until mystream.EOS
Cells(i, 1).Value = mystream.ReadText(adReadLine)

If Cells(i, 1).Value Like "//*" Then
Cells(i, 1).Delete

End If

i = i + 1
Loop

mystream.Close
Set mystream = Nothing

Call ダミー文字挿入(i)

myFileNo = FreeFile

Open "D:\test\sample_02.txt" For Output As #myFileNo

For i = 1 To i + 1
Write #myFileNo, Cells(i, 1).Value
Next i

Close #myFileNo
End Sub
=============================
Sub ダミー文字挿入(i As Long)

Dim myCellUnit(2) As String

For i = 1 To i
If Cells(i, 1) Like "@:TEXT_*" Then
myCellUnit(0) = Cells(i, 1).Value
myCellUnit(1) = Cells(i + 1, 1).Value
myCellUnit(2) = Cells(i + 2, 1).Value

If myCellUnit(1) = "" And myCellUnit(2) = "" Then
Cells(i + 1, 1) = "[dummy]"
End If
End If
Next

End Sub

回答No.1

crossgate · ベストアンサー

「Call ダミー文字挿入(i)」と最初の「End Sub」の間を完全にこれに差し替える感じで。

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

Dim val As Variant
Dim bytData() As Byte
For i = 1 To i + 1
val = val & Cells(i, 1).Value & vbLf
Next i

Set mystream = CreateObject("ADODB.Stream")
mystream.Type = adTypetext
mystream.Charset = "UTF-8"
mystream.Open
mystream.WriteText val

'BOM取り
mystream.Position = 0
mystream.Type = adTypeBinary
'mystream.Position = 3
bytData = mystream.Read
mystream.Close
'再オープン
mystream.Open
mystream.Type = adTypeBinary
mystream.Write bytData
'書き込み
mystream.SaveToFile "D:\test\sample_02.txt", adSaveCreateOverWrite
mystream.Close
Set mystream = Nothing

お礼

お礼が遅くなり大変申し訳ありません。
お陰さまで、ADO関係の技術も何とか（少しずつ）使えるようになってきました。

ありがとうございました。