ORACLE DB(UTF8) から EXCELダウンロード

ADO で、ORACLE からSELECTしていましたが、
UTF8で外字などがあると、(勝手に)SJIS変換して字化けします。
いろいろ、ネットで解決策を探したのですが、残念ながら見つからず
(解決策ありましたら、ご指導ください。)

SQLPLUS で、CSVへは、UTF8のまま落とせる方法を見つけたため
1.BATファイルを作成する
2.SQLファイルを作成する
3.BATを起動する(SQLPLUS実行==>CSVを作成)
4.CSVをEXCELでUTF8で読み込む
5.BAT,SQL,CSVファイルを削除する
という手順を考えました。↓　どうでしょうか？(一案ということで)

■シート(sheet1)は、データ展開用に先頭に空けておく

■シート(BAT)
@ECHO OFF
SET FILE_NAME=%~n0
SET NLS_LANG=Japanese_Japan.AL32UTF8
SQLPLUS -S ORCL_USER/ORCL_PASS@ORCL_DSN @%FILE_NAME%.SQL "%FILE_NAME%.CSV"
EXIT

■シート(SQL)
TTITLE OFF;
BTITLE OFF;
SET TRIM ON;
SET ECHO OFF;
SET NEWPAGE 0;
SET PAGESIZE 0;
SET COLSEP ",";
SET VERIFY OFF;
SET HEADING OFF;
SET TERMOUT OFF;
SET FEEDBACK OFF;
SET EMBEDDED OFF;
SET LINESIZE 999;
SET TRIMSPOOL OFF;

SPOOL &1;

SELECT '社員番号,カナ氏名,氏名,生年月日,性,住所' FROM DUAL;

SELECT RTRIM(MEMBERNO,' ') || ',' ||
　　　 RTRIM(KANA　　,' ') || ',' ||
　　　 RTRIM(SIMEI　 ,' ') || ',' ||
　　　 RTRIM(BYMD　　,' ') || ',' ||
　　　 RTRIM(SEX　　 ,' ') || ',' ||
　　　 RTRIM(ADRS　　,' ')
　FROM SYAIN_TBL
WHERE OFFYMD IS NOT NULL
ORDER BY MEMBERNO;

SPOOL OFF;

EXIT;

■VBA
Option Explicit

Private Sub Workbook_open()
　Dim strFileName As String
　Dim intFileNo　 As Integer
　Dim ret　　　　 As Long
　Dim i　　　　　 As Long
　Dim MaxRow　　　As Long
　Dim Bytes　　　 As Variant

　strFileName = Replace(ThisWorkbook.Name, "xlsm", "")
　ChDrive ThisWorkbook.Path
　ChDir ThisWorkbook.Path

　On Error Resume Next
' BATファイルの書出し
　Sheets("BAT").Select
　Sheets("BAT").Cells(1, 1).Select
　MaxRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
　intFileNo = FreeFile
　Open strFileName & "BAT" For Output As #intFileNo
　For i = 1 To MaxRow
　　Print #intFileNo, Sheets("BAT").Cells(i, 1).Value
　Next i
　Close #intFileNo
　If Err.Number > 0 Then
　　MsgBox "BATファイル作成に失敗しました"
　　Exit Sub
　End If

' SQLファイルの書出し
　Sheets("SQL").Select
　Sheets("SQL").Cells(1, 1).Select
　MaxRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
　With CreateObject("ADODB.Stream")
　 .Type = adTypeText
　 .Charset = "utf-8"
　 .Open
　　For i = 1 To MaxRow
　　 .WriteText Sheets("SQL").Cells(i, 1).Value, adWriteLine
　　Next i
　 .Position = 0
　 .Type = adTypeBinary
　 .Position = 3
　　Bytes = .Read
　 .Close
　End With
　With CreateObject("ADODB.Stream")
　 .Type = adTypeBinary
　 .Open
　 .Position = 0
　 .Write Bytes
　 .SaveToFile strFileName & "SQL", adSaveCreateOverWrite
　 .Close
　End With
　If Err.Number > 0 Then
　　MsgBox "SQLファイル作成に失敗しました"
　　Exit Sub
　End If

　Worksheets(1).Select

' BATの起動
　With CreateObject("Wscript.shell")
　　ret = .Run(strFileName & "BAT", 1, True)
　　If Err.Number > 0 Or ret <> 0 Then
　　　MsgBox "BAT起動・実行に失敗しました"
　　　Exit Sub
　　End If
　End With

' CSVファイル(UTF8)の読込み
　With ActiveSheet.QueryTables.Add(Connection:="text;" & _
　　　 strFileName & "CSV", Destination:=Range("A1"))
　 .TextFilePlatform = 65001
　 .TextFileCommaDelimiter = True
　 .Refresh BackgroundQuery:=False
　 .Delete
　End With

' XLSファイルの書出し
　Worksheets(1).Move
　ActiveWorkbook.SaveAs Filename:=strFileName & "xls", FileFormat:=xlExcel8
　If Err.Number > 0 Then
　　MsgBox "保存されませんでした"
　　Exit Sub
　End If

' 後始末
　Kill strFileName & "BAT"
　Kill strFileName & "SQL"
　Kill strFileName & "CSV"

　ThisWorkbook.Close SaveChanges:=False

End Sub

※テーブルは、架空のため、実は動作確認していません。
　もし、バグがありましたら、コメントください。
　(辛らつなご指摘はご容赦ください。心がすぐ折れます!)