アクセス リンク先のバックアップテーブル削除

質問

お世話になっております。

以前、リンク先DBでリンクテーブルのバックアップをとり、
同じ名称のテーブルがあったら処理しない
というVBAを教えていただいたのですが・・・
そこに付随して質問です。

Dim appAccess As Access.Application

Set appAccess = CreateObject("Access.Application")

With appAccess
.OpenCurrentDatabase strLinkDB

If numHantei = 1 Then
.DoCmd.TransferDatabase acImport, "Microsoft Access", _
strLinkDB, acTable, "T_権限情報", "BK_テーブル1_" & Format(Date, "yymmdd")
.DoCmd.TransferDatabase acImport, "Microsoft Access", _
strLinkDB, acTable, "T_社員情報", "BK_テーブル2_" & Format(Date, "yymmdd")
End If

.Quit
End With

Set appAccess = Nothing

7日以上経過したバックアップファイルを削除するには
（DoCmd.DeleteObject acTableを使って削除になるかと思いますが）、
実際、どのようにしたら可能でしょうか。

初心者につき、ご教示いただけると幸いです。
よろしくお願い致します。

回答No.1

piroin654 · ベストアンサー

いろいろとエラーを回避すると以下のようになりました。
一応、動いているようです。エラー等があれば補足してください。

Sub test()
　　Dim athDB As DAO.Database
　　Dim tdfSet As DAO.TableDef
　　Dim strLinkDB As String

　　Set athDB = CurrentDb
　　Set tdfSet = athDB.TableDefs("T_サンプル")

　　strLinkDB = Mid(tdfSet.Connect, 11)
　　Set tdfSet = Nothing
　　athDB.Close: Set athDB = Nothing

'------------------------------------
　　Dim db As DAO.Database
　　Dim i As Long

　　Set db = OpenDatabase(strLinkDB)
　　'少し込み入った検索
　　For i = db.TableDefs.Count - 1 To 0 Step -1
　　　　'"BK_サンプル_"で始まるテーブルを検索
　　　　If db.TableDefs(i).Name Like "BK_サンプル_*" Then
　　　　　　'7日以上過ぎたテーブルを検索。あれば削除。
　　　　　　'テーブル名の右から6文字取得して日付に変更。
　　　　　　If DateDiff("d", CDate(Format(Right(db.TableDefs(i).Name, 6), "@@/@@/@@")), Date) > 7 Then
　　　　　　　　db.TableDefs.Delete db.TableDefs(i).Name
　　　　　　　　db.TableDefs.Refresh
　　　　　　End If
　　　　End If
　　Next i
　　db.Close: Set db = Nothing
End Sub

お礼

ありがとうございます！
テーブル名から日付部分を抽出して「日付」に変換し、今日-7以上のテーブルを削除する・・・
なるほど！参考になりました。ありがとうございました！