エクセルVBAでアクセスのテーブルを操作

質問

アクセスのテーブルを名前を変えて保存したいのですが、エラー「2486：アクションを実行出来ない。」のメッセージが発生してしまいます。
構文は、以下の通りです。

Sub test()
Dim ACC As Object
Dim ACCC As ADODB.Connection
Dim ACCR As ADODB.Recordset
Dim SQL As String
Set ACC = Access.Application
Set ACCC = New ADODB.Connection
Set ACCR = New ADODB.Recordset
Const ACCpath = "D:\ＤＢ.mdb"
SQL = "SELECT * FROM [dammy]"

'接続し開く
ACCC.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ACCpath
ACCR.Open SQL, ACCC, adOpenStatic, adLockOptimistic

ACCR.MoveFirst
If ACCR.Fields("日付").Value < DateSerial(Year(Now), 1, 1) Then
ACC.DoCmd.CopyObject , "dammy(" & Year(Now) - 1 & "年)", acTable, "dammy"
ACC.DoCmd.RunSQL "DELETE [dammy].* FROM [dammy];"
End If
End Sub

エラー発生箇所は、IF文の中です。

対処方法を教えて下さい。
宜しくお願いします。

回答No.3

piroin654 · ベストアンサー

大事なことを忘れていました。

質問のコードと提示したコードはどちらも
Accessのファイルを開いた状態ならば実行
できるものです。つまり、

＞DoCmd.CopyObject

はカレントデータベースのみに適用できるので
起動していないとエラーが出ます。
そこで、以下のように変更してください。

Sub test3()
Dim ACC As Object
Dim ACCC As ADODB.Connection
Dim ACCR As ADODB.Recordset
Dim SQL As String
Dim strSQL As String
Dim strSQL2 As String

Set ACC = Access.Application
Set ACCC = New ADODB.Connection
Set ACCR = New ADODB.Recordset
Const ACCpath = "D:\ＤＢ.mdb"
SQL = "SELECT * FROM [dammy]"
strSQL = "DELETE * FROM [dammy];"
strSQL2 = "SELECT * INTO [;Database=D:\ＤＢ.mdb].[dammy(" & Year(Now) - 1 & "年)] FROM [dammy]"
On Error Resume Next

'接続し開く
ACCC.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ACCpath
ACCR.Open SQL, ACCC, adOpenStatic, adLockPessimistic, adCmdText

If ACCR.RecordCount > 0 Then
ACCR.MoveFirst
If ACCR.Fields("日付").Value < DateSerial(Year(Now), 1, 1) Then
ACCC.Execute strSQL2
ACCC.Execute strSQL
End If
End If
ACC.Quit
ACCR.Close: Set ACCR = Nothing
ACCC.Close: Set ACCC = Nothing
Set ACC = Nothing
End Sub

こちらで、Accessを起動したまま設定していたので
エラーが違うところに出て気がつきました。

お礼

回答ありがとうございます。
無事にエラーを解消する事が出来ました。

回答No.4

piroin654

一応確認の為。

参照設定で

Visual Basic For Application
Microsoft Excel xx ObjectLibrary
OLE Automation
Microsoft xx Object Library
Microsoft Access xx Object Library
Microsoft ActiveX Data Objects xx Library

の確認を。
xxは数字で、そちらのExcel、Accessのバージョンに
合わせたものを選択してください。

Microsoft Access xx Object Library
Microsoft ActiveX Data Objects xx Library

はどれかのAccessのファイルのコード表を開いて
参照設定で一番バージョンの高いものを
確認してExcelのコード表の参照設定で
チェックをいれてください。

お礼

回答ありがとうございます。
参照設定は、問題ありましたでした。

回答No.2

piroin654

"DELETE * FROM [dammy];"
肝心なところがそのままでした。以下で。

'レコード件数が一件以上あるならば
If ACCR.RecordCount > 0 Then
'最初のレコードのみの日付の確認だけになっていますが
ACCR.MoveFirst
If ACCR.Fields("日付").Value < DateSerial(Year(Now), 1, 1) Then
ACC.DoCmd.CopyObject , "dammy(" & Year(Now) - 1 & "年)", acTable, "dammy"
'メッセージの阻止
DoCmd.SetWarnings False
'テーブルの内容のクリア
ACC.DoCmd.RunSQL "DELETE * FROM [dammy];"
'メッセージの阻止を中止
DoCmd.SetWarnings True
End If
End If
'オブジェクトの後始末
ACCR.Close: Set ACCR = Nothing
ACCC.Close: Set ACCC = Nothing
Set ACC = Nothing
End Sub

補足

回答ありがとうございます。
しかし、エラー発生するのは、コピーオブジェクトの部分になります。
何が足りないのでしょうか？

回答No.1

piroin654

>ACC.DoCmd.RunSQL "DELETE [dammy].* FROM [dammy];"

のところを、

DoCmd.SetWarnings False
ACC.DoCmd.RunSQL "DELETE * FROM [dammy];"

のようにシステムメッセージを阻止しないとしないと、
Access側でシステムからのメッセージが
出っ放しになっていて処理が進行しないのではと思いますが。

なお、

＞"DELETE [dammy].* FROM [dammy];"

を

"DELETE * FROM [dammy];"

としていますが、これも変更してみてください。

それから、

ACCR.Close: Set ACCR = Nothing
ACCC.Close: Set ACCC = Nothing
Set ACC = Nothing
End Sub

のように後始末をすること。

でもって、少し加えて、

'レコード件数が一件以上あるならば
If ACCR.RecordCount > 0 Then
ACCR.MoveFirst
If ACCR.Fields("日付").Value < DateSerial(Year(Now), 1, 1) Then
ACC.DoCmd.CopyObject , "dammy(" & Year(Now) - 1 & "年)", acTable, "dammy"
DoCmd.SetWarnings False
ACC.DoCmd.RunSQL "DELETE [dammy].* FROM [dammy];"
End If
End If
ACCR.Close: Set ACCR = Nothing
ACCC.Close: Set ACCC = Nothing
Set ACC = Nothing
End Sub

で確認してみてください。