ExcelのデータをAccessのテーブルへインポートできない
Access VBA超初心者です。
Excelのデータの任意の列のデータをAccessの既存テーブルの任意のフィールドへインポートしたいのですが
既存Excelシートの構成は例のようにデータベース形式でないため試行錯誤しています。
Excelシートの構成は１～２行は空行、３行目と４行目にフィールド名がはいっており
セルの結合は使われていません。
データは５行目から開始されています。
＜例＞
列番号 ｜Ａ列｜Ｂ列｜Ｃ列｜Ｄ列｜Ｅ列｜
３行目 ｜ 季節 ｜ ｜
４行目 ｜ 春 ｜夏 ｜秋 ｜冬 ｜ ｜
５行目 ｜aa ｜bb ｜100 ｜200 ｜300 ｜
まず、以下の手順１と手順２を考えました。
----------------------------------------------------
◇目的
上記＜例＞のＥ列のデータを既存Accessテーブルにインポートしたい。
◇Accessの事前準備
フィールド名だけ指定し、レコードは空の状態の[a]テーブルを作成しました。
◆手順１
AccessからExcelをオブジェクトとして開き、[a]テーブルへ列単位でコピーする（）
◆手順２
[a]テーブルから条件にあうレコードを別テーブル[ｂ]のフィールドへインポートする
（ＳＱＬ文）
----------------------------------------------------
まず、手順１のコードをネット検索を参考にして以下のようにしました。
最後に「入力しました」とメッセージが表示されるもののａテーブルにデータがインポートされません。
特にエラーメッセージも表示されません。
どなたか親切にアドバイス頂ける方がいらっしゃいましたらどうぞお願いします。m(__)m
----------------------------------------------------
Public Sub エクセルインポート()
Dim xlApp As Object, xlBook As Object, xlSheet As Object, Wcell As Object
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("￥Excelファイル保存場所パス\Excelファイル.xls")
Set xlSheet = xlBook.Worksheets("Excelシート名")
Set Wcell = xlSheet.Range("a1")
Dim intNo As Integer
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cn = CurrentProject.Connection
rs.Open "a", cn, adOpenKeyset, adLockOptimistic
xlApp.Application.Visible = True
intNo = 5
Do Until rs.EOF
rs!フィールド名１ = xlApp.Application.Cells(intNo, 1).Value
rs!フィールド名２ = xlApp.Application.Cells(intNo, 2).Value
rs!フィールド名３ = xlApp.Application.Cells(intNo, 3).Value
～
rs!フィールド名21 = xlApp.Application.Cells(intNo, 21).Value
Loop
xlBook.Close
xlApp.Visible = False
Set xlBook = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
MsgBox "入力しました"
End Sub
----------------------------------------------------
お礼
早速ありがとうございました。 オフィスバージョンは、2016になります。 失礼しました。 後ほど、ご提案頂いた内容は確認をさせて頂きます。