Excel VBA 逆引き集 | 実務テンプレ完全版(超再利用部品) – 外部DB取り込みテンプレ

Excel VBA
スポンサーリンク

ねらい:外部DBから「安全・高速」に取り込み、毎日の更新を自動化する

外部DB取り込みは「接続→SQL実行→配列に読み込み→シートへ一括書き戻し」の型にすれば、数万〜数十万行でも安定して一瞬で終わります。ここでは初心者でも貼って動くテンプレを、接続(SQL Server/MySQL/SQLite)、条件付きクエリ、ページング(大量データ)、NULL/型の安全化、タイムアウト設定までかみ砕いて解説します。


共通基盤:ADO接続・レコードセット・一括書き戻し

ADO参照なし(Late Binding)でどの環境でも動く

' ModDb_Base.bas
Option Explicit

Public Function NewConn() As Object
    ' ADODB.Connection を Late Binding で生成(参照設定不要)
    Set NewConn = CreateObject("ADODB.Connection")
End Function

Public Function NewCmd() As Object
    ' ADODB.Command
    Set NewCmd = CreateObject("ADODB.Command")
End Function

Public Function NewRs() As Object
    ' ADODB.Recordset
    Set NewRs = CreateObject("ADODB.Recordset")
End Function

Public Sub WriteBlock(ByVal ws As Worksheet, ByVal a As Variant, ByVal topLeft As String)
    ws.Range(topLeft).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub

Public Function To2D(ByVal rs As Object) As Variant
    ' Recordset → 2次元配列(ヘッダ行+データ)へ変換
    Dim cols As Long: cols = rs.Fields.Count
    Dim rows As Long: rows = rs.RecordCount
    If rows < 0 Then rows = 0 ' ForwardOnly時は -1 になる可能性
    Dim data As Variant, r As Long, c As Long

    ' 可変行対応:GetRowsが高速で安定
    Dim raw As Variant
    raw = rs.GetRows() ' [列][行] 配列

    Dim nRow As Long: nRow = UBound(raw, 2) + 1
    Dim nCol As Long: nCol = UBound(raw, 1) + 1
    ReDim data(1 To nRow + 1, 1 To nCol) ' +1 はヘッダ行

    ' ヘッダ
    For c = 1 To nCol
        data(1, c) = rs.Fields(c - 1).Name
    Next
    ' データ
    For r = 1 To nRow
        For c = 1 To nCol
            data(r + 1, c) = Nz(raw(c - 1, r - 1), "")
        Next
    Next
    To2D = data
End Function

Public Function Nz(ByVal v As Variant, ByVal defVal As Variant) As Variant
    ' DBのNULLを安全に置換
    If IsNull(v) Then Nz = defVal Else Nz = v
End Function
VB

重要ポイントの深掘り

  • 参照設定不要(Late Binding)に統一すると、配布先で「参照エラー→動かない」を防げます。
  • Recordsetは GetRows で一気に配列化、最後に一括書き戻し。セル逐次書きは遅いので避けます。
  • NULLは Nz で必ず安全化。数値列へは後段で明示的に CDbl/CLng 変換するとさらに頑丈です。

接続テンプレ:SQL Server/MySQL/SQLite

SQL Server(Windows環境で最も一般的)

' ModDb_SqlServer.bas
Option Explicit

Public Function SqlServerConnection(ByVal server As String, ByVal database As String, _
                                    ByVal user As String, ByVal password As String, _
                                    Optional ByVal timeoutSec As Long = 15) As Object
    Dim conn As Object: Set conn = NewConn()
    Dim cs As String
    cs = "Provider=SQLOLEDB;" & _
         "Data Source=" & server & ";" & _
         "Initial Catalog=" & database & ";" & _
         "User ID=" & user & ";" & _
         "Password=" & password & ";" & _
         "Persist Security Info=False;"
    conn.ConnectionTimeout = timeoutSec
    conn.CommandTimeout = timeoutSec
    conn.Open cs
    Set SqlServerConnection = conn
End Function
VB

MySQL(ODBCドライバー利用)

' ModDb_MySql.bas
Option Explicit

Public Function MySqlConnection(ByVal server As String, ByVal database As String, _
                                ByVal user As String, ByVal password As String, _
                                Optional ByVal port As Long = 3306, _
                                Optional ByVal timeoutSec As Long = 15) As Object
    Dim conn As Object: Set conn = NewConn()
    Dim cs As String
    cs = "Driver={MySQL ODBC 8.0 ANSI Driver};" & _
         "Server=" & server & ";" & _
         "Port=" & port & ";" & _
         "Database=" & database & ";" & _
         "User=" & user & ";" & _
         "Password=" & password & ";" & _
         "Option=3;" ' 認証等の一般的設定
    conn.ConnectionTimeout = timeoutSec
    conn.CommandTimeout = timeoutSec
    conn.Open cs
    Set MySqlConnection = conn
End Function
VB

SQLite(ファイル型DB)

' ModDb_Sqlite.bas
Option Explicit

Public Function SqliteConnection(ByVal dbPath As String, Optional ByVal timeoutSec As Long = 15) As Object
    Dim conn As Object: Set conn = NewConn()
    Dim cs As String
    cs = "Driver={SQLite3 ODBC Driver};Database=" & dbPath & ";"
    conn.ConnectionTimeout = timeoutSec
    conn.CommandTimeout = timeoutSec
    conn.Open cs
    Set SqliteConnection = conn
End Function
VB

重要ポイントの深掘り

  • 接続文字列は“プロバイダ/ドライバ”で変わります。環境に合ったドライバをインストールしておきましょう。
  • タイムアウトは接続・コマンド両方に設定。遅延時のハング回避と、ユーザーへの明確なフィードバックができます。
  • Windows認証(Trusted_Connection)運用なら SQL Server 接続文字列を差し替え可能です。

取り込みテンプレ:全件・条件付き・ページング

全件取り込み(貼って動く)

' ModDb_Import.bas
Option Explicit

Public Sub ImportAll(ByVal conn As Object, ByVal sql As String, ByVal outSheet As String, ByVal startCell As String)
    Dim ws As Worksheet: Set ws = PrepareOut(outSheet)
    Dim rs As Object: Set rs = NewRs()
    rs.CursorLocation = 3 ' adUseClient(GetRows安定化に寄与)
    rs.Open sql, conn, 1, 3 ' adOpenKeyset, adLockOptimistic(読み込み向けなら adLockReadOnly でも可)

    Dim a As Variant: a = To2D(rs)
    WriteBlock ws, a, startCell
    ws.Columns.AutoFit
    rs.Close
End Sub

Private Function PrepareOut(ByVal name As String) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets(name): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = name
    ws.Cells.Clear
    Set PrepareOut = ws
End Function
VB

条件付き(パラメータ化で安全に)

' パラメータクエリ:SQLインジェクションを避け、型も明示
Public Sub ImportByDateRange(ByVal conn As Object, ByVal outSheet As String, _
                             ByVal startCell As String, ByVal dateFrom As Date, ByVal dateTo As Date)
    Dim cmd As Object: Set cmd = NewCmd()
    With cmd
        .ActiveConnection = conn
        .CommandText = "SELECT OrderId, CustomerId, Amount, OrderDate " & _
                       "FROM Orders WHERE OrderDate BETWEEN ? AND ?"
        .CommandType = 1 ' adCmdText
        .Parameters.Append .CreateParameter("p1", 7, 1, , dateFrom) ' adDate, adParamInput
        .Parameters.Append .CreateParameter("p2", 7, 1, , dateTo)
    End With

    Dim rs As Object: Set rs = NewRs()
    rs.CursorLocation = 3
    rs.Open cmd, , 1, 1 ' adOpenKeyset, adLockReadOnly
    Dim a As Variant: a = To2D(rs)
    WriteBlock PrepareOut(outSheet), a, startCell
    rs.Close
End Sub
VB

ページング(大量データを分割で取り込む)

' OFFSET/FETCH(SQL Server 2012+)や LIMIT/OFFSET(MySQL)を使う
Public Sub ImportPaged(ByVal conn As Object, ByVal baseSql As String, ByVal pageSize As Long, _
                       ByVal outSheet As String, ByVal startCell As String)
    Dim ws As Worksheet: Set ws = PrepareOut(outSheet)
    Dim outRow As Long: outRow = Range(startCell).Row
    Dim page As Long: page = 0
    Dim hasHeader As Boolean: hasHeader = False

    Do
        Dim sql As String
        sql = baseSql & " ORDER BY 1 OFFSET " & (page * pageSize) & " ROWS FETCH NEXT " & pageSize & " ROWS ONLY"
        Dim rs As Object: Set rs = NewRs()
        rs.CursorLocation = 3
        rs.Open sql, conn, 1, 1

        If rs.EOF Then Exit Do

        Dim a As Variant: a = To2D(rs)
        Dim startCol As Long: startCol = Range(startCell).Column

        If Not hasHeader Then
            WriteBlock ws, a, startCell
            hasHeader = True
            outRow = outRow + UBound(a, 1) - 1
        Else
            ' ヘッダ行を除いて追記
            Dim b() As Variant: ReDim b(1 To UBound(a, 1) - 1, 1 To UBound(a, 2))
            Dim r As Long, c As Long
            For r = 2 To UBound(a, 1)
                For c = 1 To UBound(a, 2)
                    b(r - 1, c) = a(r, c)
                Next
            Next
            ws.Cells(outRow + 1, startCol).Resize(UBound(b, 1), UBound(b, 2)).Value = b
            outRow = outRow + UBound(b, 1)
        End If
        rs.Close
        page = page + 1
        DoEvents ' UI凍結を防ぐ
    Loop
    ws.Columns.AutoFit
End Sub
VB

重要ポイントの深掘り

  • パラメータクエリは“安全+型明確”で必須。文字結合のWHEREは避けましょう。
  • ページングは「ヘッダ一回+データ追記」。巨大テーブルでもメモリを安定させ、UIを固めません。
  • ORDER BY 1 は「1列目で並べる」簡便記法。実務は主キーや日時で明示する方が安全です。

高速化と安全装置:型変換・NULL・タイムアウト・例外

型変換・NULLの取り扱い

' 取り込み後、数値列・日付列を安全に整形
Public Sub NormalizeTypes(ByVal ws As Worksheet, ByVal firstDataRow As Long, ByVal amountCol As Long, ByVal dateCol As Long)
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, amountCol).End(xlUp).Row
    Dim r As Long
    For r = firstDataRow To lastRow
        If Len(ws.Cells(r, amountCol).Value) > 0 Then
            ws.Cells(r, amountCol).Value = CDbl(ws.Cells(r, amountCol).Value)
        End If
        If Len(ws.Cells(r, dateCol).Value) > 0 Then
            ws.Cells(r, dateCol).Value = CDate(ws.Cells(r, dateCol).Value)
        End If
    Next
End Sub
VB

タイムアウト・再試行・例外ハンドリング

' 単純な再試行(ネットワーク瞬断対策)
Public Function SafeOpenConnection(ByVal openFuncName As String, ByVal retries As Long) As Object
    Dim i As Long
    On Error GoTo EH
    For i = 1 To retries
        Set SafeOpenConnection = Application.Run(openFuncName)
        If Not SafeOpenConnection Is Nothing Then Exit Function
    Next
    Exit Function
EH:
    If i < retries Then
        Application.StatusBar = "接続再試行中...(" & i & "/" & retries & ")"
        DoEvents
        Resume
    Else
        MsgBox "接続に失敗しました: " & Err.Description, vbExclamation
        Set SafeOpenConnection = Nothing
    End If
End Function
VB

重要ポイントの深掘り

  • 数値・日付は必ず型変換。文字のままでは並べ替え・集計が壊れます。
  • タイムアウト設定と簡易再試行で“ネットワークの揺らぎ”に強く。失敗時は明確にメッセージを出します。
  • 取り込み直後に条件付き書式(空や異常値を色付け)するとレビューが早くなります。

例題の通し方:売上テーブルを日付範囲で取り込み

実行例(SQL Server)

' ModDb_Example.bas
Option Explicit

Public Sub Demo_ImportSales()
    ' 1) 接続(SQL Server例)
    Dim conn As Object
    Set conn = SqlServerConnection("SERVERNAME", "SalesDB", "user1", "pass1", 15)

    ' 2) パラメータ取り込み(当月分)
    Dim firstDay As Date: firstDay = DateSerial(Year(Date), Month(Date), 1)
    Dim nextMonth As Date: nextMonth = DateAdd("m", 1, firstDay)
    ImportByDateRange conn, "Sales_Import", "A1", firstDay, DateAdd("d", -1, nextMonth)

    ' 3) 型正規化(Amount=3列目、OrderDate=4列目)
    NormalizeTypes Worksheets("Sales_Import"), 2, 3, 4

    MsgBox "売上取り込みが完了しました。", vbInformation
    conn.Close
End Sub
VB

重要動作の確認ポイント

  • ヘッダ行の下にデータが並び、欠損は空(または仕様値)で埋まる。
  • 金額列は数値、日付列は日付に正しく変換され、並べ替え・集計が正常に動く。
  • 接続失敗時はメッセージで分かり、再試行・タイムアウトで固まらない。

落とし穴と対策

文字結合SQLでのインジェクション・型ブレ

条件式は必ずパラメータ化。Command.Parameters で型を指定し、文字結合は避ける。

レコードセットを逐次セル書きして遅い

Recordset→配列へ一気に変換(GetRows)し、一括書き戻す。UIも固まらない。

NULL・空文字・0の混在

NzでNULLを安全に置換し、数値・日付は明示変換。欠損の扱いは仕様(空/N/A/0)に統一。

ページングなしで巨大テーブルを丸読み

OFFSET/FETCH か LIMIT/OFFSET のページングを使い、ヘッダ一回+追記で安定化。

接続文字列の差異・ドライバ未インストール

環境に合ったプロバイダ・ドライバを確認。動かない時は接続文字列を最小から試し、タイムアウトを明示。


まとめ:接続→SQL→配列→一括書き戻しの型で「速く・壊れない」取り込みにする

  • ADOのLate Binding、パラメータクエリ、GetRows→配列→一括書き戻しが核。
  • ページングとタイムアウトで大量・不安定な環境でも固まらない。
  • NULL安全化・型変換・条件付き書式で、取り込み後の“使えるデータ”に即仕上げる。

タイトルとURLをコピーしました