こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

テキストを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

投稿日時 - 2017-02-27 19:19:55

QNo.9298943

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

こんにちは
変数宣言し、その変数にどのような値をセットするのか
ハッキリさせたコードを提示するようにして下さい。
別の方法になりますが、
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

投稿日時 - 2017-02-28 09:25:17

補足

回答ありがとうございました。
早速従来のプログラムを以下のように書き換えたところ
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

投稿日時 - 2017-02-28 14:15:26

お礼

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

投稿日時 - 2017-03-28 11:42:08