はじめに

※この記事は「Visual Basic Advent Calendar 2018」2日目の記事です。
業務改善に携わるエンジニアです。今の会社に転職してからちょうど1年立ちました。
今の現場は多数のExcelファイルで業務データが管理され、秘伝のタレ的ないくつものExcelマクロで業務が回っております。
Excel撲滅を心に抱きながら改善に努めるつもりでしたが、どこでどう間違ったのか逆に自らの手でExcelマクロを増やしてしまい、こともあろうにExcelマクロ開発を効率化するライブラリまでいくつも生み出してしまいました。
1年間における己の不甲斐なさを懺悔する意味を込めて、ライブラリの1つをさらさせていただきます。

SqlQuery: 動的SQLを簡単に扱うライブラリ

SqlQueryは、動的パラメーターを使ったSQLクエリを簡単に扱うためのクラスです。以下の３つの機能を提供します。

名前付きバインド変数埋め込み（ちょっとやらかした）
IN句への配列パラメーター埋め込み（やらかした）
IN句へのタプルパラメーター埋め込み（かなりやらかした）

ソースコードはこちら。

名前付きバインド変数埋め込み

:PARAMのように、コロンで始まるパラメーター名¹をSQL文に埋め込み、パラメーター名指定で値を設定できます。
例えば

select * from user where user_name = :USER_NAME

みたいなSQL文で、USER_NAMEに値を設定して実行する場合は以下のような感じ。

Dim conn As New ADODB.Connection
conn.Open "....."
With New SqlQuery
  ' SQL文をConfig用シートのセルから取得
  ' VBAではヒアドキュメント使えないので、改行含むSQL文を扱う時によく使う一番マシなやり方
  .SqlBody = Range("SQL").Text
  ' パラメーターの設定
  .AddParam "USER_NAME", "takeruko"
  ' SqlQueryStringプロパティで、プレースホルダーがパラメーター値に置換されたSQLクエリ文字列を取得
  ' この例だと
  '   select * from user where user_name = 'takeruko'
  ' が実行される
  Dim rs As ADODB.RecordSet
  Set rs = conn.Execute(.SqlQueryString)
End With

プレースホルダーを値に置換する際の形式は、AddParamメソッドで渡した値の型から勝手に判断します。
※上記例ではStringを渡したので、シングルクォーテーションで値を囲んでいます。
Integer、Doubleなどの数値型を渡すと、値がそのまま埋め込まれ、Dateを渡すとTO_DATE関数の形式に置き換えます。

select 
  *
from
  access_log
where
  user_id = :USER_ID
  and access_time >= :ACCESS_TIME

With New SqlQuery
  .SqlBody = Range("SQL").Text
  .AddParam "USER_ID", 12345
  .AddParam "ACCESS_TIME", #10/1/2018 1:23:45 PM#
  ' select
  '   *
  ' from
  '   access_log
  ' where
  '   user_id = 12345
  '   and access_time >= TO_DATE('2018-10-01 13:23:45', 'YYYY-MM-DD HH24:MI:SS')
  ' が実行される
  Set rs = conn.Execute(.SqlQueryString)
End With

名前付きバインド変数はoo4oでも扱えるので、車輪の再発明的なやらかした感があります。
が、このクラスはOracle以外でも名前付きバインド変数が使えるのがポイントです。²
ただ、ソースコードを見れば分かる通り、SQLインジェクションの脆弱性ありです。³

IN句への配列パラメーター埋め込み

IN句に渡すパラメーターを配列で渡せます。プレースホルダーは下記SQLのように1つだけ埋め込みます。値はAddParamメソッドにVariant配列で渡します。

select * from user where user_name in (:USER_NAME)

With New SqlQuery
  .SqlBody = Range("SQL").Text
  .AddParam "USER_NAME", Array("takeruko", "taro", "hanako")
  ' select * from user where user_name in ('takeruko', 'taro', 'hanako')
  ' が実行される
  Set rs = conn.Execute(.SqlQueryString)
End With

ちなみに、AddParamは複数範囲参照のRangeを渡してもOKです。例えば以下のようにA2:A4セルの値をパラメーターとして使用する場合。

こんな風にすればOK。

  .AddParam "USER_NAME", Range("A2:A4")

なかなか便利なんですが、自分でもやらかした感がしてます。

IN句へのタプルパラメーター埋め込み（かなりやらかした）

タプルパラメーターはwhere (col1, col2) in ( (1, 'a'), (2, 'b'), ... )みたいに複数項目の組み合わせをIN句で指定するやり方です。⁴
SQL文に埋め込むプレースホルダーは相変わらず1つで、AddParamに2次元配列を渡せばOKですが、複数列参照のRangeで渡すのが楽です。

select * from user_group where (group_id, user_id) in (:PARAM)

  .AddParam "PARAM", Range("A2:B5")
  ' select * from user_group
  ' where (group_id, user_id) in (
  '   (1, 11111),
  '   (2, 11111),
  '   (1, 22222),
  '   (2, 33333)
  ' )
  ' が実行される
  Set rs = conn.Execute(.SqlQueryString)

2019年に向けて

脱Excel！に向けて頑張りたいです。
つーか、Excelのマクロ言語にPython採用するとかしないとかのアンケート、あれからどうなったんですかね。
実現すれば、こんなライブラリ作らなくても良くなるのに。

ソースコード

後日、GitHubあたりにて公開予定。

Option Explicit
'##################################################################################################
' Class: SqlQuery
' Description:
'   パラメーター付きSQLクエリの文字列を生成するクラスです。
'   名前付きバインド変数、IN句への配列パラメーターやtupleの配列パラメーター挿入ができます。
'
'##################################################################################################

Private s_sqlBody As String
Private dict_params As Object
Private e_dbType As DB_TYPE

' RDBMSの種類
' 日付時刻のフォーマット指定子切り替えや、SQLの方言の切り替えに使う
' 今のところOracleしか対応してない
Public Enum DB_TYPE
    ORACLE
End Enum

' AddParamメソッドで渡すパラメーター値の型を表す
' AddParamの引数として使うつもりだったけど、パラメーターがtupleの場合にどうするか思いついていないので、
' Privateで使っているだけ
Private Enum PARAMETER_TYPE
    VarChar
    Number
    Date
    Unknown
End Enum

'------ コンストラクタ ------
Private Sub Class_Initialize()
    s_sqlBody = ""
    Set dict_params = CreateObject("Scripting.Dictionary")
    e_dbType = DB_TYPE.ORACLE
End Sub

'------ プロパティ -----
Public Property Let SqlBody(v As String)
    s_sqlBody = v
End Property

Public Property Get SqlBody() As String
    SqlBody = s_sqlBody
End Property

Public Property Get ParamKeys() As Variant()
    ParamKeys = dict_params.Keys()
End Property

Public Property Get Param(key As Variant) As Variant
    Param = dict_params(key)
End Property

Public Property Let DbType(v As DB_TYPE)
    e_dbType = v
End Property

Public Property Get DbType() As DB_TYPE
    DbType = e_dbType
End Property

' SQLクエリにバインド変数を適用させた文字列を返す
Public Property Get SqlQueryString() As String
    Dim sqlStr As String
    sqlStr = s_sqlBody

    ' SQLクエリ中のバインド変数を、AddParamでセットした値の文字列表現に置換する
    Dim key As Variant
    For Each key In dict_params.Keys
        sqlStr = bindParamToSql(sqlStr, CStr(key), dict_params(key))
    Next key

    SqlQueryString = sqlStr
End Property

' バインド変数を追加
' bindNameにはSQLに埋め込んだプレースホルダー(:で始まる文字列)のコロンを除いた文字列を指定(例: where userid = :USERID なら"USERID")
Public Sub AddParam(bindName As String, value As Variant)
    Dim v As Variant

    ' Rangeオブジェクトの値を取り出す
    ' Rangeが複数範囲を参照している場合は、Variantの2次元配列が返ってくる
    If TypeName(value) = "Range" Then
        v = value.value
    Else
        v = value
    End If

    ' valueが2次元配列だったら、tupleを表すVariant配列に置換する
    If is2DArray(v) Then
        v = MakeTupleParamList(v)
    End If

    ' バインド変数名が追加済の場合はvalueを上書きする
    If dict_params.Exists(bindName) Then
        dict_params.Item(bindName) = v
    Else
        dict_params.Add bindName, v
    End If

End Sub

' バインド変数、値をクリア
Public Sub CleanParams(bindName As String)
    dict_params.RemoveAll
End Sub


' 2次元配列をtupleを表現するVariant配列のネストに変換する
' 例: SQL上のtuple parametersが
'   where (col1, col2, col3) in ( (1, 'a', 'あ'), (2, 'b', 'い'), (3, 'c', 'う') )
'
'   の場合､このFunctionは
'
'   Array(
'     Array(1, "a", "あ"),
'     Array(2, "b", "い"),
'     Array(3, "c", "う")
'   )
'
'   を返す
Private Function MakeTupleParamList(v As Variant) As Variant

    Dim i As Long, j As Long
    Dim i_min As Long, i_max As Long, j_min As Long, j_max As Long
    i_min = LBound(v, 1)
    i_max = UBound(v, 1)
    j_min = LBound(v, 2)
    j_max = UBound(v, 2)

    Dim paramList() As Variant
    ReDim paramList(i_min To i_max)
    For i = i_min To i_max
        Dim tuple() As Variant
        ReDim tuple(j_min To j_max)
        For j = j_min To j_max
            tuple(j) = v(i, j)
        Next j
        paramList(i) = tuple
    Next i

    MakeTupleParamList = paramList
End Function

' 引数で渡された値が2次元配列か否かを返す
Private Function is2DArray(v As Variant) As Boolean

    ' 配列の次元数を取得する仕組み
    ' 配列arrayのi次元の要素数をUBound(array, i)で取得する際、
    ' iがarrayの次元数を超えるとエラーになることを利用する
    On Error Resume Next
    Dim tmp As Variant
    Dim i As Long: i = 0
    Do While Err.Number = 0
        i = i + 1
        tmp = UBound(v, i + 1)
    Loop

    is2DArray = (i = 2)

End Function

' SQL中のプレースホルダーを値で置換する
' TODO: SQLインジェクション対策
Private Function bindParamToSql(sql As String, bindName As String, value As Variant) As String
    With CreateObject("VBScript.RegExp")
        .pattern = "¥s*:" & bindName & "([¥s,¥)]?)"
        .IgnoreCase = False
        .Global = True
        bindParamToSql = .Replace(sql, " " & paramValueString(value) & "$1")
    End With
End Function

' プレースホルダーを置き換える値を表現する文字列を生成
' 値が配列だったら、カンマ区切りで連結した文字列を返す
Private Function paramValueString(value As Variant) As String

    If IsArray(value) Then
        Dim a() As Variant
        ReDim a(LBound(value) To UBound(value))
        Dim i As Long
        For i = LBound(value) To UBound(value)
            a(i) = paramExpressionByType(value(i))
        Next i
        paramValueString = Join(a, ", ")
    Else
        paramValueString = paramExpressionByType(value)
    End If

End Function

' 値の型に応じて、SQLに埋め込むべき文字列を生成
'  - 数値型:   値をそのまま
'  - 文字列型: シングルクォーテーションで囲む
'  - 日付型:   日付型を返すSQL関数の形式で返す(TO_DATEとか)
'  - 型不明:   文字列型として扱う(シングルクォーテーションで囲む)
' 値がtupleの場合はカッコでくくった文字列を返す
Private Function paramExpressionByType(value As Variant) As String
    Dim v As Variant
    If Not IsArray(value) Then
        v = value
    ElseIf LBound(value) = UBound(value) Then
        ' 要素数1の配列はtupleにすると冗長なので
        ' ('a') -> 'a'
        ' とする
        v = value(LBound(value))
    Else
        ' tupleの場合はカッコでくくった文字列を返す
        ' tuple内の各値はparamValueStringで適切な文字列表現に置換
        paramExpressionByType = "(" & paramValueString(value) & ")"
        Exit Function
    End If

    ' 型に応じた文字列を返す
    Select Case getParameterType(v)
        Case PARAMETER_TYPE.VarChar
            paramExpressionByType = "'" & v & "'"
        Case PARAMETER_TYPE.Number
            paramExpressionByType = v
        Case PARAMETER_TYPE.Date
            paramExpressionByType = getDateTimeFunc(v)
        Case Else
            paramExpressionByType = "'" & v & "'"
    End Select
End Function

' Excelの値型をSQLの型で分類・判別
Private Function getParameterType(value As Variant) As PARAMETER_TYPE
    Select Case TypeName(value)
        Case "Byte", "Integer", "Long", "LongLong", _
             "Single", "Double", "Currency", "Decimal"
            getParameterType = PARAMETER_TYPE.Number
        Case "Date"
            getParameterType = PARAMETER_TYPE.Date
        Case "String"
            getParameterType = PARAMETER_TYPE.VarChar
        Case Else
            getParameterType = PARAMETER_TYPE.Unknown
    End Select
End Function

' 日付型は文字列->日付型に変換する関数の形式に変換する
Private Function getDateTimeFunc(v As Variant) As String
    Dim datetimeStr As String
    datetimeStr = Format(v, "yyyy-mm-dd hh:nn:ss")

    ' 文字列->日付型変換の関数はRDBMSによって異なる
    Select Case e_dbType
        Case DB_TYPE.ORACLE
            getDateTimeFunc = "TO_DATE('" & datetimeStr & "', 'YYYY-MM-DD HH24:MI:SS')"
    End Select
End Function

Oracle Clientで提供される名前付きバインド変数の形式です。Oracle形式をチョイスした理由は、単に職場のDBがOracleだからです。 ↩
でも、今の自分の仕事ではOracleしか使ってないので、言っていることが矛盾してますゴメンナサイ。 ↩
でも、職場ではSELECT権限のみのユーザーで運用しているので、気が向いたら対応します。 ↩
SQL99からの仕様らしいです。 ↩

Excel VBAで動的SQLを簡単に扱うライブラリを作った（やらかした感満載）