ねらい:外部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
VBMySQL(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
VBSQLite(ファイル型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安全化・型変換・条件付き書式で、取り込み後の“使えるデータ”に即仕上げる。

