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
----------------------------------------------------

回答No.1

gatyan · ベストアンサー

rsに対して　addnew　とか　update　してますか？

お礼

ご回答ありがとうございました。
アドバイスのように下記内容にしましたら一応「読み込む」ことはできました。

「少数を丸めたために、データが切り捨てられました.」という実行時エラーが出てきましたので、明日じっくり再検討します。
おかげさまで少し前に進むことができました。
本当にありがとうございました。m(__)m

その後の経過も明日以降またご報告させて頂きます。

-------------------
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

rs.AddNew
xlApp.Application.Visible = False

intNo = 5 'Excelデータの取得開始行番号
Do Until rs.EOF

rs.MoveFirst
rrs!フィールド名１ = 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

rs.Update
rs.MoveNext
intNo = intNo + 1
Loop

補足

>rsに対して　addnew　とか　update　してますか？
あ、すみません。していませんでした。
どこに記述すればよいですか・・。