フィールド見出しを転記する

フィールドのデータ型を反映させる

ユーザー定義関数「getDataType」を利用して転記先に書式を設定する

Sub getDataTypeを使用して書式設定()
Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset, FileName As String
Dim myTbl As String, myRng As Range, i As Integer

'接続先のファイル、取込元テーブル、取込先を指定
FileName = ThisWorkbook.Path & "\mdb\2-sampleDB.mdb"
myTbl = "伝票一覧"
Set myRng = ThisWorkbook.Worksheets(1).Range("A1")

myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName
myRS.Open myTbl, myCon

'データを転記
myRng.Offset(1).CopyFromRecordset myRS

For i = 0 To myRS.Fields.Count - 1
  'フィールド見出しを転記
  myRng.Offset(0, i) = myRS.Fields(i).Name
  '書式設定
  Range(myRng.Offset(0, i), myRng.Offset(0, i).End(xlDown)) _
        .NumberFormatLocal = getDataType(myRS.Fields(i).Type)
Next

'列幅調整
myRng.CurrentRegion.EntireColumn.AutoFit

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

End Sub

Typeプロパティの値を変換するユーザー定義関数「getDataType」

Function getDataType(tmpLng As Long) As String
Dim tmpStr As String

'受け取った定数に応じた書式を文字列で設定
Select Case tmpLng
  Case adSmallInt: tmpStr = "0"
  Case adInteger: tmpStr = "0"
  Case adCurrency: tmpStr = "\#,##0;\-#,##0"
  Case adDate: tmpStr = "[$-411]ggge.m.d;@"
  Case adBoolean: tmpStr = "G/標準"
  Case adVarWChar: tmpStr = "@"
  Case Else: tmpStr = "G/標準"
End Select

'書式設定を文字列として返す
getDataType = tmpStr

End Function

任意のフィールドのデータ型は、FieldオブジェクトのTypeプロパティを使用する。
Typeプロパティに関しては、こちらを参照。

Excelに書式を転記するには、Typeプロパティの値をExcelでの書式設定を行うNumberFormatLocalプロパティに指定できる値に変換する