Office 2016 for MacのVBAでUTF-8テキストファイルを出力する

# まえがき
ActiveX Data Objects(ADODB)がないOffice 2016 for Macにおいて、VBAでUTF-8なテキストファイルを出力する方法です。

最初妥協策として[UTF-16で出力していました](https://qiita.com/Nebutan/items/a2b00d44b5296bd4c9a1)が、その後意地になってUTF-8版を作りましたので公開します。

## 2020/10/6追記
__コードに不具合がありますので、ご利用の方はコメント欄もご参照ください。__

# コード
```vb:utf8.xlsm
Option Base 0

' 文字列をUTF-8でPutする
' 引数:
'	fileNum: Openステートメントで指定したファイル番号
'	str: 出力する文字列
' 備考:
'	ファイルは Open 〜 For Binary で開かれていること
Sub PutUTF8String(ByVal fileNum As Integer, ByRef str As String)
    Dim byteUTF8() As Byte	' 文字をUTF-8エンコードしたものを格納する
    Dim c, d As String		' 変換する文字 (dはサロゲートペア下位用)
    Dim i, w, v As Integer	' ループカウンタと文字コード取得用
	Dim u As Long			' Unicode化した文字コード

	' For 〜 Next ではなく Do 〜 Loop なのはループ中でカウンタを飛ばすため
	i = 1
	Do While i <= Len(str)
        c = Mid(str, i, 1)
        w = AscW(c)

		if w >= &HD800 And w < &HDBFF then
			' サロゲートペア上位の場合はカウンタを進めて下位も取得する
			' ToDo: サロゲートペア下位の値チェック
			i = i + 1
	        d = Mid(str, i, 1)
	        v = AscW(d)

			' サロゲートペアのデコード
			u = &H10000& + ((w And &HFFFF&) - &HD800&) * &H400& + ((v And &HFFFF&) - &HDC00&)
		Else
			' 符号ありで表現された文字コードを符号なし表現へ
			u = w And &HFFFF&
		End If

		byteUTF8() = Unicode2UTF8(u)
        
        Put #fileNum, , byteUTF8

		i = i + 1
	Loop
End Sub

' UnicodeをUTF-8にエンコードする
' 引数:
'	u: Unicode文字コード
' 戻値:
'	UTF-8エンコードした文字のByte配列
Function Unicode2UTF8(u As Long) As Byte()
	Dim byteUTF8() As Byte

	Select Case u
		Case Is < &H80&
			ReDim byteUTF8(0)
			byteUTF8(0) = CByte(u)
		Case Is < &H800&
			ReDim byteUTF8(1)
			byteUTF8(0) = CByte(((u And &H7F0&) / 64) + 192)
			byteUTF8(1) = CByte((u And &H3F&) + 128)
		Case Is < &H10000&
			ReDim byteUTF8(2)
			byteUTF8(0) = CByte(((u And &HF000&) / 4096) + 224)
			byteUTF8(1) = CByte(((u And &HFC0&) / 64) + 128)
			byteUTF8(2) = CByte((u And &H3F&) + 128)
		Case Is < &H200000&
			ReDim byteUTF8(3)
			byteUTF8(0) = CByte(((u And &H1C0000&) / 262144) + 240)
			byteUTF8(1) = CByte(((u And &H3F000&) / 4096) + 128)
			byteUTF8(2) = CByte(((u And &HFC0&) / 64) + 128)
			byteUTF8(3) = CByte((u And &H3F&) + 128)
		Case Else
			' UTF-8で5バイト以上になる範囲はエラー代わりに1バイトの0を返す
			ReDim byteUTF8(0)
			byteUTF8(0) = 0
	End Select

	Unicode2UTF8 = byteUTF8()
End Function

' サンプル
' 選択中ワークシートのA1セルの内容をブックと同ディレクトリの test.txt に出力
Sub WriteFileTest()
    Dim FilePath As String
    Dim UnicodeString As String
    
    FilePath = ThisWorkbook.Path & "/test.txt"
    UnicodeString = Range("A1").Value

    ' ファイルがすでに存在する場合は削除
    ' これを忘れると既存ファイルの一部が出力ファイル末尾に残ったりする
    If Dir(FilePath) <> "" Then
        Kill FilePath
    End If

    Open FilePath For Binary Access Write As #1

    PutUTF8String 1, UnicodeString

    Close #1
End Sub
```

# 実行結果
* Excelのマクロに上記コードを登録
* A1セルに「123 abcABC§©®　ａｂｃＡＢＣあいうアイウｱｲｳ亜唖娃弌丐丕髙杮鷗𩸽😀😁😂👩‍👩‍👦‍👦」をペースト
<img width="824" alt="PutUTF8Excel.png" src="https://qiita-image-store.s3.amazonaws.com/0/16150/3dc5197f-1fa0-b86f-a8c3-c054d4ad1710.png">
* `WriteFileTest`を実行
* 出力されたファイルをテキストエディットで開いた結果
<img width="440" alt="PutUTF8Result.png" src="https://qiita-image-store.s3.amazonaws.com/0/16150/8224ce03-981c-aa95-7583-d997b4689357.png">
* 出力されたファイルをダンプした結果

```
$ od -t x1 test.txt 
0000000    31  32  33  20  61  62  63  41  42  43  c2  a7  c2  a9  c2  ae
0000020    e3  80  80  ef  bd  81  ef  bd  82  ef  bd  83  ef  bc  a1  ef
0000040    bc  a2  ef  bc  a3  e3  81  82  e3  81  84  e3  81  86  e3  82
0000060    a2  e3  82  a4  e3  82  a6  ef  bd  b1  ef  bd  b2  ef  bd  b3
0000100    e4  ba  9c  e5  94  96  e5  a8  83  e5  bc  8c  e4  b8  90  e4
0000120    b8  95  e9  ab  99  e6  9d  ae  e9  b7  97  f0  a9  b8  bd  f0
0000140    9f  98  80  f0  9f  98  81  f0  9f  98  82  f0  9f  91  a9  e2
0000160    80  8d  f0  9f  91  a9  e2  80  8d  f0  9f  91  a6  e2  80  8d
0000200    f0  9f  91  a6                                                
0000204
```

# やっていること
* 文字列を1文字ずつばらす
* ばらした文字をAscWにかけてUnicode値を取得する
    * サロゲートペアだった場合はデコードする
* 取得したUnicode値をUTF-8にエンコードしてByte配列に格納する
* Byte配列をPutする

# 備考とあとがき
U+200000以上の文字はゼロ文字に変換します。
サロゲートペア下位の値範囲チェックは省略していますのでご注意ください。

動作確認はmacOS Sierra 10.12.6 + Excel for Mac 16.12(180410) Office365版で行いました。

UTF-8のエンコードはSelect Caseを使わずに書けそうな気もしますが、今後の課題とさせてください‥‥‥

# 参考
[VBAでサロゲートペア対応Len](https://qiita.com/RelaxTools/items/966bfc1810e6c94b9d07)
[VBAで絵文字💖]
(https://qiita.com/masaoki/items/3488320842a9c3f9fc4e)