VBAでActiveXを使用せずにファイル出力する方法

VBAでActiveXを使用せずにファイル出力する方法

要件

・Excelのシートから特定の範囲をTSVに出力する
・出力するファイルの文字コードをUTF-8にする

実装内容

Option Explicit

' Windows API 宣言（UTF-16 → UTF-8 変換）
'※Excelのバージョンが2010以上の場合は上の分岐になる
#If VBA7 Then
    Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, ByVal dwFlags As Long, _
        ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, _
        ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr _
    ) As Long
#Else
    Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, ByVal dwFlags As Long, _
        ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, _
        ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long _
    ) As Long
#End If

Const CP_UTF8 As Long = 65001

Sub ボタン1_Click()

    Dim ws As Worksheet
    Set ws = ActiveSheet
   
    Dim rng As Range
    Set rng = ws.Range("C6").Resize(4, 10) ' ← 行数・列数を指定
   
    Dim arr As Variant
    arr = rng.Value ' 配列に一括取得
   
    Dim ff As Long
    Dim filePath As String
    filePath = "C:\test\test.tsv" ' 保存先
   
    ff = FreeFile
    Open filePath For Binary As ff
    
    Dim r As Long, c As Long
    Dim line As String, v As String
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    ' ファイルに書き込む
    For r = 1 To UBound(arr, 1)
        line = ""
        For c = 1 To UBound(arr, 2)
            v = CStr(arr(r, c))
            v = Replace(v, """", """""") ' " を "" に変換
            line = line & """" & v & """"
            If c < UBound(arr, 2) Then line = line & vbTab
        Next c
        line = line & vbLf
       
        Put ff, , ToUTF8(line)
    Next r
   
    Close ff
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "出力 完了：" & filePath

End Sub


'------------------------------
' UTF-16 → UTF-8 変換関数
'------------------------------
Private Function ToUTF8(ByVal s As String) As Byte()
    Dim n As Long
    n = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    Dim b() As Byte
    ReDim b(0 To n - 1) As Byte
    WideCharToMultiByte CP_UTF8, 0, StrPtr(s), Len(s), VarPtr(b(0)), n, 0, 0
    ToUTF8 = b
End Function

さいごに学習背景

VBAからActiveXを使用しない改修をするため学習を開始。

時代背景の参考程度にChatGPTで以下が出力される状態である。

Q（入力内容）
エクセルでActiveXを使用する際のリスクを教えて
A（ChatGPTの出力抜粋）
ActiveX を Excel で使うことは
・セキュリティ上の大きなリスク
・環境依存による運用トラブル
・将来的な非互換性
といった問題を抱えています。
そのため現在では、
フォームコントロールや Office Scripts、アドイン、VSTO などへの置き換え
が推奨される流れになっています。

ChatGPTの情報を鵜呑みにするのはQiita投稿ルール的にもよろしくないので、申し訳程度に以下ページを確認する。（常識で考えても鵜呑みはNG）

最適なセキュリティを確保するために、Microsoft では、絶対に必要な場合を除き、ActiveX コントロールを無効にすることを強くお勧めします。

ページ内のこの1文でMicrosoft公式も非推奨としていることが読み取れる。