Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında.

dilerim işinize yarar, ama dikkatli kullanmakta yarar var önce yedeğini alıp öyle deneyin
VT'ye eklenecek modülün kodu
aşağıdaki kod dosyanın açık olup olmadığını kontrol etmek için

Option Compare Database

Option Explicit



Function IsFileOpen(FileName As String)

    Dim iFilenum As Long

    Dim iErr As Long

    

    On Error Resume Next

    iFilenum = FreeFile()

    Open FileName For Input Lock Read As #iFilenum

    Close iFilenum

    iErr = Err

    On Error GoTo 0

    

    Select Case iErr

    Case 0:    IsFileOpen = False

    Case 70:  IsFileOpen = True

    Case Else: Error iErr

    End Select

    

End Function

Dosya açıksa kapatma Fonksiyonu

Function AciksaKapat(DsyAdrs As String)

If IsFileOpen(DsyAdrs) = True Then ' açık ise aşağıdaki kodlar ile kapatır

    Dim BglVt As Access.Application

    Set BglVt = GetObject(DsyAdrs)

    BglVt.Application.Quit

End If

'''''On Error GoTo HataCik



'''''HataCik:

End Function

Forma eklenecek buton kodu

Private Sub BtnOnarLinkedTbl_Click()

Dim TblAdi As TableDef

Dim BglVtAdr, DzBglVtAdr As String

Dim BglVt As Object

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



        x = InStr(1, TmpAdres, ";DATABASE=")

        TmpAdres = Mid(TmpAdres, 11)

        If x = 1 And 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) '

AciksaKapat CStr(BglVtAdr(x))



    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"

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



Next x

MsgBox "Sıkıştır onar bitti"

End Sub

(30/05/2020, 17:32)berduş yazdı: dilerim işinize yarar, ama dikkatli kullanmakta yarar var önce yedeğini alıp öyle deneyin
VT'ye eklenecek modülün kodu aşağıdaki kod dosyanın açık olup olmadığını kontrol etmek için

Option Compare Database

Option Explicit



Function IsFileOpen(FileName As String)

    Dim iFilenum As Long

    Dim iErr As Long

    

    On Error Resume Next

    iFilenum = FreeFile()

    Open FileName For Input Lock Read As #iFilenum

    Close iFilenum

    iErr = Err

    On Error GoTo 0

    

    Select Case iErr

    Case 0:    IsFileOpen = False

    Case 70:  IsFileOpen = True

    Case Else: Error iErr

    End Select

    

End Function

Forma eklenecek Fonksiyonlar
Buton kodu

Private Sub BtnOnarLinkedTbl_Click()

Dim TblAdi As TableDef

Dim BglVtAdr, DzBglVtAdr As String

Dim BglVt As Object

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



        x = InStr(1, TmpAdres, ";DATABASE=")

        TmpAdres = Mid(TmpAdres, 11)

        If x = 1 And 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) '

AciksaKapat CStr(BglVtAdr(x))



    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"

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



Next x

MsgBox "Sıkıştır onar bitti"

End Sub

Dosya açıksa kapatma Fonksiyonu

Function AciksaKapat(DsyAdrs As String)

If IsFileOpen(DsyAdrs) = True Then ' açık ise aşağıdaki kodlar ile kapatır

    Dim BglVt As Access.Application

    Set BglVt = GetObject(DsyAdrs)

    BglVt.Application.Quit

End If

'''''On Error GoTo HataCik



'''''HataCik:

End Function

   Teşekkür ederim, deneyip bilgi vereceğim.

(30/05/2020, 17:48)tekinuygun yazdı:

(30/05/2020, 17:32)berduş yazdı: dilerim işinize yarar, ama dikkatli kullanmakta yarar var önce yedeğini alıp öyle deneyin
VT'ye eklenecek modülün kodu aşağıdaki kod dosyanın açık olup olmadığını kontrol etmek için

Option Compare Database

Option Explicit



Function IsFileOpen(FileName As String)

    Dim iFilenum As Long

    Dim iErr As Long

    

    On Error Resume Next

    iFilenum = FreeFile()

    Open FileName For Input Lock Read As #iFilenum

    Close iFilenum

    iErr = Err

    On Error GoTo 0

    

    Select Case iErr

    Case 0:    IsFileOpen = False

    Case 70:  IsFileOpen = True

    Case Else: Error iErr

    End Select

    

End Function

Forma eklenecek Fonksiyonlar
Buton kodu

Private Sub BtnOnarLinkedTbl_Click()

Dim TblAdi As TableDef

Dim BglVtAdr, DzBglVtAdr As String

Dim BglVt As Object

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



        x = InStr(1, TmpAdres, ";DATABASE=")

        TmpAdres = Mid(TmpAdres, 11)

        If x = 1 And 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) '

AciksaKapat CStr(BglVtAdr(x))



    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"

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



Next x

MsgBox "Sıkıştır onar bitti"

End Sub

Dosya açıksa kapatma Fonksiyonu

Function AciksaKapat(DsyAdrs As String)

If IsFileOpen(DsyAdrs) = True Then ' açık ise aşağıdaki kodlar ile kapatır

    Dim BglVt As Access.Application

    Set BglVt = GetObject(DsyAdrs)

    BglVt.Application.Quit

End If

'''''On Error GoTo HataCik



'''''HataCik:

End Function

   Teşekkür ederim, deneyip bilgi vereceğim.

 Teşekkür ederim Sayın @berduş kodlar çalışmakta. Emeğinize sağlık.

Iyi calismalar)

Merhabalar, maalesef kodları denedim bende çalışmıyor,
Function AciksaKapat(DsyAdrs As String)
yukarıdaki kodda dosya adresini istiyor bunu nerden ve nasıl alıyor veya alacak.
yalnızca Private Sub BtnOnarLinkedTbl_Click()
bu kodu çalıştırıyorum, MsgBox "Sıkıştır onar bitti"
çıkıyor ama sıkıştırma ve onarma işlemini yapmıyor?

AciksaKapat(DsyAdrs As String) burada dosya adresini DsyAdrs ile biz yolluyoruz
BtnOnarLinkedTbl_Click yordamını çalıştırınca bağlı tabloların veritabanı adreslerini alıp döngüye sokuyor
döngüde AciksaKapat CStr(BglVtAdr(x)) kodu DsyAdrs ile dosya adresini yolluyor