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

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

Sub フィールド見出しを転記()
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

'フィールド見出しを転記
For i = 0 To myRS.Fields.Count - 1
  myRng.Offset(0, i) = myRS.Fields(i).Name
Next

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

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

End Sub

実行結果