データベースからのデータ取得

Sub 一覧取得()

  Dim cn As ADODB.Connection
  Dim rs As ADODB.Recordset
  Set cn = New ADODB.Connection
  Set rs = New ADODB.Recordset

  Dim strSQL
  Dim DB_FILE As String
  Dim SHEET_LIST As String

  DB_FILE = "C:\www\confidential\New登録スタッフデータ.mdb"
  SHEET_LIST = "スタッフ一覧"

  Application.ScreenUpdating = False
  strSQL = "SELECT スタッフID,氏名 FROM Tableスタッフ名簿M "
  cn.Open "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & DB_FILE
  rs.Open strSQL, cn, adOpenStatic, adLockOptimistic, adCmdText         'SQLを実行


  'CLEAR
  ClearCells

  
  Dim RG_CI As Range, RG_CO As Range, Cinput As Variant, Coutput As Variant, Ans As Long, j As Long

  Set RG_CO = Sheets(SHEET_LIST).Range("A10:Z3300")
  
  Coutput = RG_CO '（１）転記該当範囲の確保

  MsgBox TypeName(rs.Fields.Count) & " 列数" & rs.Fields.Count & " 総件数：" & rs.RecordCount & "件"
 
  'Exit Sub
  '（２）データセット保存
  
  For i = 1 To rs.RecordCount
    
    Coutput(i, 1) = rs!スタッフID
    Coutput(i, 2) = rs!氏名
    'Coutput(i, 3) = rs!フリガナ
    'Coutput(i, 4) = rs!性別
    'Coutput(i, 5) = rs!自宅郵便番号
    'Coutput(i, 6) = rs!自宅都道府県
    'Coutput(i, 7) = rs!自宅住所1
    'Coutput(i, 8) = rs!自宅住所2
    
    rs.MoveNext
  
  Next i

  RG_CO = Coutput '（３）該当Rangeへの転記
  
  'MsgBox ("リスト取得完了。 総件数：" & rs.RecordCount)
  
  'バッファ廃棄
  
  rs.Close:  Set rs = Nothing
  cn.Close:  Set cn = Nothing

End Sub