アクセス テーブルデータ他のテーブルにコピーVBA

質問

win10
access365のmdbファイルにおいて

table1のフィールド1がID　数値型　長整数型
値要求あり　重複あり
フィールド2が氏名　短いテキスト型　225
値要求なし　重複あり　

table2；フィールド1がID　数値型　長整数型
値要求あり　重複あり
フィールド2が氏名　短いテキスト型　225
値要求なし　重複あり　

上記に置いて
table2の新しいデータとして
table1のデータをコピーしたい、
ただしtable1には　レコードは１行だけとします
（table1にレコードが複数行ある場合の最新レコードだけtable2にコピーも出来れば知りたいです）

アクセス付属の更新クエリーでは、どうも　うまくいきません
ｓｑｌにおいて
UPDATE table1, table2 SET table2.ID = [table1]![ID], table2.氏名 = [table1]![氏名];
上記動作しません

Function table1から2()
Dim db As DAO.Database
Dim rst As Recordset

Dim TB As Table
Dim Rdset As Recordset
On Error Resume Next
Set db = DBEngine(0)(0)

Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE)
Rdset.AddNew
Rdset![ID] = Table![table1]![ID]
Rdset![氏名] = Table![table1]![氏名]
Rdset.Update

End Function

table1, table2を　それぞれ
同名のフォームを作り

Function table1から2()
Dim db As DAO.Database
Dim rst As Recordset
Dim fm As Form

Dim Rdset As Recordset
On Error Resume Next
Set db = DBEngine(0)(0)
Set fm = Forms![table1]
If Rdset.BOF Then
Exit Function
Else
Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE)
Rdset.AddNew
Rdset![ID] = Forms![table1]![ID]
Rdset![氏名] = Forms![table1]![氏名]
Rdset.Update

End If
End Function

いずれも
table2のデータ更新が　なされていません
すみません
宜しくお願い致します

回答No.1

kkkkkm · ベストアンサー

> table2の新しいデータとして
> table1のデータをコピーしたい、

単に追加でいいんですよね。以下で試してみてください。

> ただしtable1には　レコードは１行だけとします

Sub Test()
Dim StrSQL As String

StrSQL = "INSERT INTO table2 SELECT table1.* FROM table1;"

DoCmd.SetWarnings False
DoCmd.RunSQL StrSQL
DoCmd.SetWarnings True

End Sub

> （table1にレコードが複数行ある場合の最新レコードだけtable2にコピーも出来れば知りたいです）

Sub Test2()
Dim StrSQL As String

StrSQL = "INSERT INTO table2 ( ID, 氏名 ) SELECT " & _
"Last(table1.ID) AS IDの最後1, " & _
"Last(table1.氏名) AS 氏名の最後 " & _
"FROM table1;"

DoCmd.SetWarnings False
DoCmd.RunSQL StrSQL
DoCmd.SetWarnings True

End Sub

お礼

出来ました　有り難うございました。

Powered by GRATICA