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

1 2 3
30/05/2020, 17:32

berduş

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:48

tekinuygun

(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.
31/05/2020, 18:14

tekinuygun

(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.
31/05/2020, 18:19

berduş

Iyi calismalar)
25/05/2023, 15:01

ates2014

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?
25/05/2023, 15:43

berduş

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
1 2 3