テキストをUNICODEで記録するには

質問

現在エクセルVBAで以下のコードを使用してセルから読み込んだデータをテキストファイルに変換するプログラムを使用しています。
今回下記のコードだと文字化けしてしまう文字（韓国語）を扱うことになりました。
エクセルの保存形式を「Unicode」で保存すると問題なくテキストができることがわかりました。
そこで下記のプルグラムで保存形式を「Unicode」で保存する方法を教えてください。

ターゲットになる変数は「text」という変数です。

よろしくお願いします。

Open "x:\文字.txt" For Append As #1
If a = "" Then
Print #1, Chr(9); text
Else
Print #1, Format(a, "@"); Chr(9); intime; "/"; outtime; Chr(9); text
No = No + 1
End If
Close #1
n = n + 1

回答No.1

ushi2015

こんにちは
変数宣言し、その変数にどのような値をセットするのか
ハッキリさせたコードを提示するようにして下さい。
別の方法になりますが、
Sub test()
　　Dim a　　 As String
　　Dim intime As Long
　　Dim outtime As Long
　　Dim txt2　　As Object
　　Dim Text　　As String
　　Dim tPath As String

　　tPath = "x:\文字.txt"

　　Set txt2 = CreateObject("ADODB.Stream")

　　txt2.Type = adTypeText
　　txt2.Charset = "UTF-8"
　　' 改行コードを設定（-1：CRLF、10：LF、CR：13）
　　txt2.LineSeparator = -1

　　Text = Range("A1").Text
　　a = "1"

　　txt2.Open
　　txt2.LoadFromFile tPath
　　txt2.Position = txt2.Size

　　If a = "" Then
　　　　txt2.WriteText Chr(9) & Text, adWriteLine
　　Else
　　　　txt2.WriteText Format(a, "@") & Chr(9) & intime & "/" & outtime & Chr(9) & Text, adWriteLine
　　End If
　　txt2.SaveToFile tPath, 2
　　txt2.Close
　　Set txt2 = Nothing
End Sub

お礼

お礼メールが遅れてすみませんでした。
ありがとうございました。

補足

回答ありがとうございました。
早速従来のプログラムを以下のように書き換えたところ
txt2.Type = adTypeText
の行でエラーになってしまいます。
エラー名は
実行時エラー'3001':
引数が間違った型、許容範囲外、または競合しています。
とでます。
申し訳ありませんが解決方法などお分かりでしたら教えてください。

Sub MakeCAP()
Dim a As String
Dim intime As String
Dim outtime As String
Dim txt2 As Object
Dim Text As String
Dim tPath As String

tPath = "x:\文字.txt"

n = 1

No = 1

Set txt2 = CreateObject("ADODB.Stream")

txt2.Type = adTypeText
txt2.Charset = "UTF-8"
'改行コードを設定（-1:CRLF,10:LF,CR:13)
txt2.LineSeparator = -1

Do
a = Cells(n, 1)
intime = Cells(n, 2)
outtime = Cells(n, 3)
Text = Cells(n, 4)

txt2.Open
txt2.LoadFromFile tPath
txt2.Position = txt2.Size

If a = "" Then
txt2.WriteText Chr(9) & Text, adwriteline
Else
txt2.WriteText Format(a, "@") & Chr(9) & intime & "/" & outtime & Chr(9) & Text, adwriteline
No = No + 1
End If
txt2.saveToFile tPath, 2
txt2.Close
Set txt2 = Nothing
n = n + 1

Loop Until Text = ""

End Sub