【Excel VBA】PostgreSQLのDBに接続してデータを取得する方法【テスト効率化】

記事のターゲット

各種テスト等のDBダンプをExcelに出力したい人
ODBC等DB関連知識が少しある方

1 はじめに
2 事前準備
- 2.1 ODBCインストール
- 2.2 接続情報を記述したテキストファイルを作成する
3 VBAで処理を記述
4 使い方

はじめに

　今回は、Excel上に連続して記述したSQLの回数DBからデータを取得して別シートに整形して出力するVBAを作成したので公開いたします。また、接続情報を外部テキストで管理する方法も同時に行っているのでそちらも同時に紹介いたします。

事前準備

ExccelとPostgresを連携するために必要なODBCをインストールします。

すでにインストール済みの場合はスキップしてしまってOKです。

ODBCインストール

細かな設定方法については以下サイト様を参照してください。

ExcelのVBAでODBC接続を使ってポスグレのDB操作をする方法

簡単にまとめるとPostgreSQLの公式サイトからPostgreSQLと同じバージョンのODBCをインストール(ビット数は合わせる)し、必要手順を踏んで有効化します。そのあとExccel側のVBAで参照設定を追加するといった流れになります。

接続情報を記述したテキストファイルを作成する

今回、DBへの接続情報をExcelにべた書きはせず、使いまわせるように外部ファイルで定義します。

そのためにまず以下の形式で記述したテキストファイルを任意のフォルダに作成します。筆者はアドインを配置するフォルダに置いています。

server	DBサーバのIPアドレスまたはlocalhostを設定。
dbname	接続するDB名
password	パスワード
provider	プロバイダーはMSDASQLで固定 (参照)https://learn.microsoft.com/ja-jp/sql/connect/connect-history?view=sql-server-ver16
driver	ドライバについてもPostgreSQL Unicodeで固定
UID	postgres
port	PostgreSQLの接続先サーバが稼働しているポートを指定

VBAで処理を記述

以下コードのfilePathに設定ファイルを配置したパスを指定してください。

'postgres 連続されたSQL文実行後取得結果を別シートに整形して出力ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub ShowSQLresultTable()

    '接続情報取得のための変数定義
    Dim filePath As String
    Dim fileRow As Integer
    Dim textRow As String
    Dim serverKey As String, dbnameKey As String, passwordKey As String, providerKey As String, driverKey As String, uidKey As String, portKey As String
    Dim SERVER As String, DBNAME As String, PASS As String, PROVIDER As String, DRIVER As String, UID As String, PORT As String
　　'DB接続情報を配置したファイルパスを指定する。
    filePath = "C:\~\~\定義ファイル名"
    fileRow = FreeFile()
    Open filePath For Input As fileRow

    ' テキストファイルから行を1行ずつ読み込んで各定義を探索
    Do Until EOF(fileRow)
        Line Input #fileRow, textRow
        If InStr(1, textRow, "server = ", vbTextCompare) > 0 Then
            SERVER = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        ElseIf InStr(1, textRow, "dbname = ", vbTextCompare) > 0 Then
            DBNAME = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        ElseIf InStr(1, textRow, "password = ", vbTextCompare) > 0 Then
            PASS = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        ElseIf InStr(1, textRow, "provider = ", vbTextCompare) > 0 Then
            PROVIDER = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        ElseIf InStr(1, textRow, "driver = ", vbTextCompare) > 0 Then
            DRIVER = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        ElseIf InStr(1, textRow, "UID = ", vbTextCompare) > 0 Then
            UID = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        ElseIf InStr(1, textRow, "port = ", vbTextCompare) > 0 Then
            PORT = Trim(Mid(textRow, InStr(1, textRow, "=") + 1))
        End If
    Loop
    
    ' 設定ファイルを閉じる
    Close fileRow
    
    'DB接続情報の設定
    Dim CNN As Object
    Dim RS As Variant
    Set CNN = CreateObject("ADODB.Connection")
    CNN.Open "Provider=" & PROVIDER & ";Driver=" & DRIVER & ";UID=" & UID & ";Port=" & PORT & ";Server=" & SERVER & ";Database=" & DBNAME & ";PWD=" & PASS

    'データ取得のための変数定義
    Dim CN As ADODB.Connection
    Dim SQLTime As String
    Dim inputCell As Range
    Dim SQLList As New Collection
    Dim newSheet As Worksheet
    Dim count As Integer
    Dim colCounter As Integer
    Dim Item As Variant
    
    Set inputCell = ActiveCell
    
    ' 下方向に連続した非空のセルの文字列を取得
    Do While Not IsEmpty(inputCell.Value)
        SQLList.Add inputCell.Value
        ' 次のセルに移動
        Set inputCell = inputCell.Offset(1, 0)
    Loop
    
    ' 新しいシートを作成
    Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
    
    ' シートのA1セルを選択
    newSheet.Range("A1").Select
    
    '実行時刻を取得するSQL
    SQLTime = "SELECT CURRENT_TIMESTAMP;"
    
    ' 開始セルを指定
    Set inputCell = ActiveCell
    count = 0

    For Each Item In SQLList
    
        '現在時刻を取得
        Set RS = New ADODB.Recordset
        RS.Open SQLTime, CNN, adOpenKeyset, adLockOptimistic, adCmdText
        inputCell.Offset(count, 0).Value = RS.Fields(0).Value
        'inputCell.Value = RS.Fields(0).Value
        RS.Close
        count = count + 1
    
        '各SQLを実行
        Set RS = New ADODB.Recordset
        RS.Open Item, CNN, adOpenKeyset, adLockOptimistic, adCmdText
        inputCell.Offset(count, 0).Value = Item
        count = count + 1
        
        'テーブルのヘッダーとデータを出力する。
        ' ヘッダーの出力
        For colCounter = 1 To RS.Fields.count
            inputCell.Offset(count, colCounter - 1).Value = RS.Fields(colCounter - 1).Name
            inputCell.Offset(count, colCounter - 1).Interior.Color = RGB(198, 224, 180)
            inputCell.Offset(count, colCounter - 1).Borders.LineStyle = True
        Next colCounter
        
        count = count + 1
        
        ' データの出力
        Do Until RS.EOF
            For colCounter = 1 To RS.Fields.count
                inputCell.Offset(count, colCounter - 1).Value = RS.Fields(colCounter - 1).Value
                inputCell.Offset(count, colCounter - 1).Borders.LineStyle = True
            Next colCounter
            count = count + 1
            RS.MoveNext
        Loop
    
        RS.Close
        
        count = count + 1
        
    Next

    ' レコードセット、データベースを閉じる
    CNN.Close
    Set CNN = Nothing
End Sub