EXCELのデータをUnicode(UTF-16)形式のCSVに出力

EXCELでCSVを出力すると、Shift-Jisのままになってしまうので、第2水準漢字などが「?」に変換されてしまう。

それを、VBAで対応しようしたのが以下のソース。

かなり重宝するのでメモとして残す。

ちなみに、「EXCEL UNICODe CSV マクロ」で検索して見つけたサイトに記載されていた。

回答した方に拍手！！

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

'Option Explicit

Sub CSV_OutputByUnicode()
　　Dim rng As Range
　　Dim i As Long, j As Long
　　Dim Fso As Object
　　Dim f As Object
　　Dim fName As Variant
　　Dim buf As String
　　Dim TxtLine As String
　　Dim objTxt As Object
　　Dim OverWrite As Boolean
　　Dim mPath As String
　　'出力パス
　　mPath = ActiveWorkbook.Path & "\"
　　Set rng = Selection
　　
　　'範囲のチェック（マウスで選択）
　　If rng.Cells.Count < 3 Then
　　　　MsgBox "範囲を選択してください。", vbExclamation
　　　　Exit Sub
　　End If
　　On Error GoTo ErrHandler
Start:
　　Do
　　　　fName = Application.InputBox("出力名を入れてください。", "CSV出力", Type:=2)
　　　　If VarType(fName) = vbBoolean Then Exit Sub
　　Loop Until fName <> ""
　　fName = mPath & fName
　　'拡張子のチェック
　　If InStrRev(fName, ".") = 0 Then
　　　　fName = fName & ".csv"
　　ElseIf StrConv(Right(fName, InStrRev(fName, ".") + 1), vbNarrow) <> "csv" Then
　　　　fName = Right(fName, InStrRev(fName, ".")) & "csv"
　　End If
　　'ファイルの上書きチェック
　　If Dir(fName) <> "" Then
　　　　If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then
　　　　　　OverWrite = True
　　　　Else
　　　　　　GoTo Start
　　　　End If
　　End If
　　'出力
　　Set Fso = CreateObject("Scripting.FileSystemObject")
　　Set f = Fso.CreateTextFile(fName, OverWrite, True)
　　For i = 1 To rng.Rows.Count
　　　　For j = 1 To rng.Columns.Count
　　　　　　buf = buf & "," & rng.Cells(i, j).Text
　　　　Next j
　　　　If TxtLine = "" Then
　　　　　　TxtLine = Mid(buf, 2)
　　　　Else
　　　　　　TxtLine = TxtLine & vbCrLf & Mid(buf, 2)
　　　　End If
　　　　buf = ""
　　Next i
　　f.Write (TxtLine & vbCrLf)
　　f.Close
ErrHandler:
　　If Err.Number > 0 Then
　　　　MsgBox Err.Number & " : " & Err.Description
　　Else
　　　　MsgBox fName & vbCrLf & "出力しました。", vbInformation
　　End If
　　Set objTxt = Nothing
　　Set f = Nothing
　　Set Fso = Nothing
　　Set rng = Nothing
End Sub

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

フォームからボタンを選択してエントリポイントを作成すればOKなので本当に簡単！

昨日からずっと悩んでいたのでスッキリしたぞー！