ExcleVBA에서 ODBC 연결로 PostgreSQL로 INSERT를 한다.

처음에

Excel 데이터를 직접 DB에 등록하는 매크로입니다.
직장에서 Excel에서 테스트 데이터를 만들고 매번 도구로 복사하여 자동화했습니다.
아직도, 개량・ 고려의 여지는 있습니다.

환경

OS: Windows10Pro 64bit
Office:Office2013 64bit※
※Microsoft에서는 32bit판의 이용을 추천하고 있는 것 같습니다.
PostgreSQL ODBC: psqlodbc_10_03_0000-x64
PostgreSQL 무케 ODBC 드라이버
ODBC 설정: 64bit 버전
제어판->관리 도구->ODBC 데이터 소스(64비트)
※Office가 32bit판의 경우, ODBC도 32bit판을 인스톨 해 주세요.




라이브러리의 참조 설정은 다음과 같이 했습니다.새로 참조한 것은 아래 2개입니다.

Excel 시트

item_mst에 초점을 맞추고 매크로를 실행하기 만하면됩니다.

코드

매개 변수의 단일 인용 및 NULL 고려

Function getTypeVal (val As String, columnDataType As String)

getTypeVal.vba

    If val = Cells(1, 1) Then
        getTypeVal = "null"
    Else
        If columnDataType = "char" Then
            getTypeVal = "'" & val & "'"
        Else
            getTypeVal = val
        End If
    End If

Function getSheetData()

getSheetData.vba

    Dim 現在行 As Long
    Dim 現在列 As Long
    現在行 = Selection.Row
    現在列 = Selection.column
    Dim データ開始行 As Long
    Dim データ開始列 As Long
    Dim データ終了行 As Long
    Dim データ終了列 As Long
    Dim カラム行 As Long
    データ開始行 = 2 + 現在行
    データ開始列 = 現在列
    カラム行 = 1 + 現在行
    データ終了行 = Selection.End(xlDown).Row
    データ終了列 = Cells(カラム行, 現在列).End(xlToRight).column
    Dim DataBase() As Variant
    DataBase = Range(Cells(データ開始行, データ開始列), Cells(データ終了行, データ終了列))
    getSheetData = DataBase

Sub insertTable()

insertTable

    Dim テーブル名 As String
    Set c = Selection
    テーブル名 = Trim(c.value)

    If テーブル名 = "" Then
        MsgBox "テーブル名を指定してください。"
        Exit Sub
    End If

    Dim DataBase() As Variant
    DataBase = getSheetData()
    '行数
    Dim RowNum As Double
    '列数
    Dim ColNum As Double

    RowNum = UBound(DataBase, 1)                    '行数取得
    ColNum = UBound(DataBase, 2)                    '列数取得

    Dim cn As ADODB.Connection
    Set cn = New ADODB.Connection
    cn.ConnectionString = "DSN=local_PostgreSQL;"
    cn.Open

    ' ADOレコードセットを生成
    Dim objRS As ADODB.Recordset
    Set objRS = New ADODB.Recordset

   Dim infoSql As String
   infoSql = getDataType(テーブル名)
    'テーブル情報取得
    objRS.Open infoSql, cn
    '配列に入れ替え
    ReDim columnTypes(ColNum - 1) As String
    Dim i As Integer
    Do Until objRS.EOF
        columnTypes(i) = objRS(0).value
        i = i + 1
       objRS.MoveNext
    Loop
    If i = 0 Then
        MsgBox "テーブルが存在しません。"
        Exit Sub
    End If

    Dim sql As String
    sql = getInsertSQL(テーブル名, DataBase, columnTypes)
    'トランケート
    cn.Execute ("truncate table item_mst")
    'インサート
    cn.Execute sql
    objRS.Close
    Set objRS = Nothing
    cn.Close
    Set cn = Nothing

Function getInsertSQL (테이블 이름 As String, DataBase As Variant, ByRef columnDataTypes() As String)

getInsertSQL

    Dim sql As String
    sql = "insert into " & テーブル名 & " values "
    'ループ変数
    Dim i As Double
    Dim j As Double
    '行数
    Dim RowNum As Double
    '列数
    Dim ColNum As Doubl
    RowNum = UBound(DataBase, 1)                    '行数取得
    ColNum = UBound(DataBase, 2)                    '列数取得
    Dim strTmp As String
    Dim value As String
    For i = 1 To RowNum
        If i <> 1 Then
            sql = sql + " , "
        End If
        sql = sql + " ( "
        For j = 1 To ColNum
            If j <> 1 Then
                sql = sql + " , "
            End If
            strTmp = DataBase(i, j)
            value = getTypeVal(strTmp, columnDataTypes(j - 1))
            sql = sql + value
         Next
          sql = sql + " )"
    Next
   getInsertSQL = sql

Function getDataType (tableName As String)

getDataType

    Dim sql As String
    sql = ""
    sql = sql + " SELECT case when  A1.data_type LIKE 'char%' THEN 'char' ELSE 'other' END  AS column_data_type "
    sql = sql + " FROM   information_schema.columns A1"
    sql = sql + " WHERE  A1.table_name = '" & tableName & "'"
    sql = sql + " ORDER  BY A1.ordinal_position"
    getDataType = sql