【Excel】VBでDB接続方法

ADODB.Connection PostgreSQL接続

  strConn = "DRIVER={PostgreSQL Unicode};DATABASE=db;SERVER=192.168.1.99;
              PORT=5432;UID=XX;PWD=XXX;"
  'If IsEmpty(conn) Then Set conn = CreateObject("ADODB.Connection")
  Set conn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
  On Error Resume Next
  '************************************
  conn.Open strConn
  rs.Open "select pg_backend_pid()", conn  'バックエンドプロセスID
  Debug.Print "(1).....PID:" & rs.Fields(0).Value
  '-----------------------
  conn.Execute "CREATE TEMP TABLE TTEST (fld1 integer,fld2 text);"
  '-----------------------
  Debug.Print IIf(Err.Number = 0, "create ok", Err.Description)
  Err.Clear
  rs.Close
  conn.Close    ' --------- closeでセッションが終わる訳ではない
  '************************************
  conn.Open strConn
  rs.Open "select pg_backend_pid()", conn 
  Debug.Print "(2).....PID:" & rs.Fields(0).Value
  '-----------------------
  conn.Execute "CREATE TEMP TABLE TTEST (fld1 integer,fld2 text);"
  '-----------------------
  Debug.Print IIf(Err.Number = 0, "create ok", Err.Description)
  Err.Clear
  rs.Close
  conn.Close
  '************************************
  'ADODB.Connectionを開放
  Set conn = Nothing
  Set conn = CreateObject("ADODB.Connection") '再生成してみる
  '************************************
  conn.Open strConn
  rs.Open "select pg_backend_pid()", conn
  Debug.Print "(3).....PID:" & rs.Fields(0).Value
  '-----------------------
  conn.Execute "CREATE TEMP TABLE TTEST (fld1 integer,fld2 text);"
  '-----------------------
  Debug.Print IIf(Err.Number = 0, "create ok", Err.Description)
  Err.Clear
  rs.Close
  conn.Close　'　　<--広域変数にしcloseしないとセッションの再利用可能

MYSQL接続

Sub test()

Dim con As ADODB.Connection
Dim rs As ADODB.Recordset

Dim connectionString As String
Dim sqlStr As String

Dim rowNo As Integer
Dim colNo As Integer
Dim item As Variant

'接続文字列
connectionString = "Driver={MySQL ODBC 5.1 DRIVER};" _
                & " SERVER=localhost;" _
                & " DATABASE=cocoadb;" _
                & " USER=root;" _
                & " PASSWORD=admin;"

'ADODB.Connection生成
Set con = New ADODB.Connection

On Error GoTo Err

'MySQLに接続
con.Open connectionString

'SQL文
sqlStr = "select * from ms_usr"

'SQL文実行
Set rs = con.Execute(sqlStr)

'シートデータクリア
Worksheets("Sheet1").Cells.Clear

rowNo = 1
colNo = 1

'RecordSetの終了まで
Do While rs.EOF = False

    'データ抽出
    For Each item In rs.fields
        Worksheets("Sheet1").Cells(rowNo, colNo).Value = item.Value
        colNo = colNo + 1
    Next
    colNo = 1
    rowNo = rowNo + 1

    '次のレコード
    rs.MoveNext
Loop

'クローズ
con.Close
Set rs = Nothing
Set con = Nothing

Exit Sub

Err:
    Set rs = Nothing
    Set con = Nothing
    MsgBox (Err.Description)

End Sub