dilerim işinize yarar ama eğer diğer VeriTabanları açıksa sorun çıkarabilir

Dim TblAdi As TableDef

Dim BglVtAdr, DzBglVtAdr As String

DzBglVtAdr = ""

'Veritabanındaki Tüm Bağlı tabloların Adresini alır ve mtin olarak kaydeder

For Each TblAdi In CurrentDb.TableDefs

        TmpAdres = TblAdi.Connect

        TmpAdres = Mid(TmpAdres, 11)

        If Len(TmpAdres & "") > 0 And InStr(1, DzBglVtAdr, TmpAdres) = 0 Then DzBglVtAdr = DzBglVtAdr & ";" & TmpAdres

 Next TblAdi



BglVtAdr = Split(DzBglVtAdr, ";") 'farklı Vtlerden bağlanmış tablolar varsa tüm diğer VTlerin adlarını diziye aktarır

    

For x = 1 To UBound(BglVtAdr) '

    DBEngine.CompactDatabase BglVtAdr(x), BglVtAdr(x) & "TMP"

    If Dir(BglVtAdr(x) & ".BCK") <> "" Then Kill BglVtAdr(x) & ".BCK"

    Name BglVtAdr(x) As BglVtAdr(x) & ".BCK"

    Name BglVtAdr(x) & "TMP" As BglVtAdr(x)

    If Dir(BglVtAdr(x) & "TMP") <> "" Then Kill BglVtAdr(x) & "TMP"

Next x

End Sub