Accessファイル確認ツール④(ExcelでRDBその16)

ExcelでRDB（リレーショナルデータベース）を操作してみようという連載のその16です。前回の記事はこちらです。

hirocom777.hatenadiary.org

もう少し改善してみる

Accessファイル確認ツールに取り組んでいます。かなりいい線まで来ました。でも、未だ改善できることがありますね。

]

今回も改善に取り組みました。今回の内容を適用したツールを以下に置いておきますので興味のある方はダウンロードしてみてください。

16_Accessファイル確認ツール④.zip - Google ドライブ

データの表示がおかしい件

もう1つは読込結果の表示です。日付表示などのデータが上手く表示されません。日付表示などの場合はセルの書式設定を変更するようにしました。

'テーブル内容のExceシートへの展開を実行します
Public Sub cmdTable_Click()
Dim db As clsAccessDbase
Dim outputSheet As Worksheet
Dim i As Long
  If Me.Range("TableName").Text = "" Then Exit Sub
  'データベースに接続します
  Set db = New clsAccessDbase
  db.dbFileName = Me.Range("FileName").Text
  db.dbTableName = Me.Range("TableName").Text
  '出力用のブックを開きます
  Set outputSheet = Workbooks.Add.ActiveSheet
  outputSheet.Name = db.dbTableName
  'データを表示します
  For i = 0 To UBound(db.dbFieldList)
    outputSheet.Range("A1").Offset(0, i) = db.dbFieldList(i)
    '日付型の場合は日付表示に変更
    If db.dbFieldType(i) = adDate Then
      outputSheet.Range("A1").Offset(0, i).EntireColumn.NumberFormatLocal = "yyyy/m/d"
    End If
    '日付/時刻型の場合は日付/時刻表示に変更
    If db.dbFieldType(i) = adDBTimeStamp Then
      outputSheet.Range("A1").Offset(0, i).EntireColumn.NumberFormatLocal = "yyyy/m/d h:mm;@"
    End If
  Next i
  db.SelectRecord "TRUE", outputSheet.Range("A2")
End Sub

データ型の取得をADOXからADOに修正

確認してみたらデータ型の取得はADOXだけではなく、ADOでもできるのでした。クラス改造をしてデータ型を取得できるプロパティーを追加しました。（クラスのリストは別の機会に掲載します）また、一部テーブルの内容が読めないことがあります（~TMPCLPで始まる名前のテーブル。ごみデータなどだと思います）。この時のエラー処理を追加しました。

'カラムリストを表示します
Private Sub DispColumnList(fileName As String, tableName As String)
Dim catalogObject As New ADOX.Catalog
Dim columnObject As Object
Dim keyObject As Object
Dim db As clsAccessDbase
Dim columnName As Variant
Dim listRange As Range
Dim i As Long
On Error GoTo ErrorHandler
  '表示がある場合にはクリアします
  If Me.Range("I10").Value <> "" Then
    Range(Me.Range("F10"), Me.Range("I10").SpecialCells(xlLastCell)).ClearContents
    Me.Range("A10").Activate
  End If
  
  'データベースに接続します(ADO)
  Set db = New clsAccessDbase
  db.dbFileName = Me.Range("FileName").Text
  db.dbTableName = Me.Range("TableName").Text
  Set listRange = Me.Range("columnList").Offset(1, 0)
  'カラム名とデータ型を表示します
  For i = 0 To UBound(db.dbFieldList)
    listRange.Offset(i, 0) = db.dbFieldList(i)
    listRange.Offset(i, -1) = GetDataInfo(CLng(db.dbFieldType(i)))
    listRange.Offset(i, -3) = i + 1
  Next i
  Set db = Nothing
  
  'カラム名範囲を再設定
  Set listRange = Range(listRange, listRange.Offset(i, 0))
  'データベースを接続します(ADOX)
  catalogObject.ActiveConnection = _
    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fileName
  'キー情報を表示します
  For Each keyObject In catalogObject.Tables(tableName).Keys
    For Each columnObject In keyObject.Columns
      listRange.Find(columnObject.Name, , , xlWhole).Offset(0, -2).Value = GetKeyInfo(keyObject.Type)
    Next
  Next
  Exit Sub
ErrorHandler:
  MsgBox "テーブルエラーです"
End Sub