SQL用クラスモジュール
使用例
Sub sqlclass()
Dim sql As DataExcelSQL: Set sql = New DataExcelSQL
Dim ws As Worksheet: Set ws = Sheet2
Dim strSQL As String: strSQL = _
"SELECT SC,名称,市場,業種,株価 FROM [Sheet1$] WHERE 株価>2000;"
sql.mRead (strSQL)
If Not sql.pDataExists Then Exit Sub
ws.Cells.Clear
sql.mOutput ws, "A1", True
End Subメソッドとプロパティ
メソッド
| 名称 | return | 説明 |
| Class_Initialize | 無し | 初期化処理 |
| mRead | 無し | SQLのSELECT文を実行する。 引数1（必須）：SQL文をString型で渡す |
| mCrud | 無し | SQLのINSERT/UPDATEを実行する（めったに使わない） 引数1（必須）：SQL文をString型で渡す |
| mOutput | 無し | SQLで取得したデータをワークシートに出力する 引数1（必須）：Worksheetオブジェクトを渡す 引数2（必須）：セル番地をString型で渡す "A1″ など 引数3（任意）：ヘッダー有無をTrue/Falseで指定 省略したらTrue |
| mPrintTableInfo | 無し | SQLで取得したデータの列数と行数をイミディエイトウィンドウにprintする |
| printError | 無し | デバッグ用 エラーメッセージをprintする 引数1（必須）：String型でエラーが発生した関数名など渡す 引数2（必須）：String型のエラー文を自分で書くかerr.Descriptionで渡す 引数3（任意）：Long型のエラー番号 err.Number でOK |
プロパティ
| 名称 | return | 説明 |
| pDataExists | Boolean型 | SQLで取得したデータが存在するか返す |
| pArrDataBody | Variant型 | SQLで取得したデータを二次元の配列変数で返す 引数1（任意）：ヘッダー有無をTrue/Falseで指定 省略したらTrue |
| pArrColumns | Variant型 | SQLで取得したデータのヘッダーを一次元配列で返す |
| pStrColumns | String型 | SQLで取得したデータのヘッダーをカンマ区切りの文字列で返す |
クラスモジュール
オブジェクト名：DataExcelSQL
Option Explicit
'=============================================================================
'参照設定「Microsoft ActiveX Data Objects 2.8 Library」（6.1でもOK、2.7以下は未検証）
'参照設定「Microsoft Scripting Runtime」
'=============================================================================
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Private colIndex As Scripting.Dictionary
Private dataBody() As Variant
Private dataExists As Boolean
Private Sub Class_Initialize()
Set colIndex = New Scripting.Dictionary
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Provider = "MSDASQL"
cn.ConnectionString = _
"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & ThisWorkbook.FullName & "; ReadOnly=True;"
End Sub
'SELECT用
Public Sub mRead(strSQL As String)
cn.Open 'DB接続
'SQL実行
On Error GoTo omg
rs.Open strSQL, cn, adOpenStatic
On Error GoTo 0
' レコードの取得 Transposeで向き変更
Dim tmp As Variant
If Not rs.EOF Then tmp = rs.GetRows
dataBody = WorksheetFunction.Transpose(tmp)
dataExists = True
' 列のIndex作成
' countプロパティは1ベースなのにコレクションは0ベースっぽいので-1必要
Dim i As Long
For i = 0 To rs.Fields.Count - 1
colIndex.Add rs.Fields(i).Name, i + 1
Next i
rs.Close: cn.Close 'DB切断
Exit Sub
'-----------------------------------------------------------------
'エラー処理
omg:
If Not rs.State = 0 Then rs.Close
Set rs = Nothing
cn.Close: Set cn = Nothing
Debug.Print Time() & " SQL失敗"
Debug.Print strSQL
Call printError("mRead", Err.Description, Err.Number)
End Sub
'デバッグ用 エラーメッセージをprintする
Private Sub printError(errWhere As String, errDescription As String, Optional errNumber As Long)
Debug.Print String("50", "-")
If errNumber = 0 Then
Debug.Print errWhere & "： " & errDescription
Else
Dim str As String: str = Replace(errDescription, "。", "。\n")
Dim arr: arr = Split(str, "\n")
Debug.Print errWhere & "：ERROR NUMBER " & Err.Number
Dim i As Long
For i = 0 To UBound(arr) - 1
Debug.Print arr(i)
Next i
End If
Debug.Print String("50", "-")
End Sub
'INSERT/UPDATE用
Public Sub mCrud(ByVal strSQL As String)
cn.Open 'DB接続
'SQL実行
On Error GoTo omg
rs.Open strSQL, cn, adOpenStatic
On Error GoTo 0
'DB切断
If Not rs.State = 0 Then rs.Close
cn.Close
Exit Sub
'-----------------------------------------------------------------
'エラー処理
omg:
If Not rs.State = 0 Then rs.Close
Set rs = Nothing
cn.Close: Set cn = Nothing
Call printError("mCrud", Err.Description, Err.Number)
End Sub
'テーブルをワークシートに出力する headerがTRUEならヘッダーを含む
Public Sub mOutput(ws As Worksheet, rng As String, Optional header As Boolean = True)
If Not dataExists Then
Call printError("mOutputエラー", "出力できるデータがありません。")
Exit Sub
End If
Dim arr: arr = Me.pArrDataBody(header)
ws.Range(rng).Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
'テーブルの行数と列数をイミ窓にprintする
Public Sub mPrintTableInfo()
Debug.Print String("50", "-")
Debug.Print "mPrintTableInfo"
If dataExists Then
Debug.Print "行数：" & UBound(dataBody) & " (※ヘッダーは含まない数)"
Debug.Print "列数：" & UBound(colIndex.Keys) + 1 & Replace(" (?)", "?", Me.pStrColumns)
Else
Debug.Print "まだ取得したデータはありません"
End If
Debug.Print String("50", "-")
End Sub
'返すデータ型：Boolean｜内容：SQLで取得したデータがあったらTrue、無いならFalse
Public Property Get pDataExists() As Boolean
pDataExists = dataExists
End Property
'返すデータ型：一次元配列（起点0）｜内容：列名の文字列
Public Property Get pArrColumns() As Variant
If Not dataExists Then
Call printError("pArrColumns", "出力できるデータがありません。")
Exit Property
End If
pArrColumns = colIndex.Keys
End Property
'返すデータ型：String｜内容：列名をカンマ区切りした文字列
Public Property Get pStrColumns() As String
If Not dataExists Then
Call printError("pStrColumns", "出力できるデータがありません。")
Exit Property
End If
Dim arr: arr = colIndex.Keys
Dim i As Long, tmp As String
For i = 0 To UBound(arr)
tmp = tmp & CStr(arr(i)) & ","
Next i
pStrColumns = Left(tmp, Len(tmp) - 1)
End Property
'返すデータ型：二次元配列（起点1）｜内容：保有中のテーブル｜HeaderがTrueならヘッダー込み、Falseならデータ部分のみ
Public Property Get pArrDataBody(Optional header As Boolean = True) As Variant
If Not dataExists Then
Call printError("pArrDataBody", "出力できるデータがありません。")
Exit Property
End If
If Not header Then
pArrDataBody = dataBody
Else
Dim i As Long, j As Long, hd: hd = Me.pArrColumns
Dim arr() As Variant
ReDim arr(1 To UBound(dataBody) + 1, 1 To UBound(dataBody, 2))
'ヘッダー部分
For i = 1 To UBound(arr, 2)
arr(1, i) = hd(i - 1)
Next i
'データ部分
For i = 1 To UBound(dataBody)
For j = 1 To UBound(arr, 2)
arr(i + 1, j) = dataBody(i, j)
Next j
Next i
pArrDataBody = arr
End If
End Property