AccessTr.neT

AccessTr.neT > Microsoft Access > Access Cevaplanmış Soruları > Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında.
Tam Versiyon: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında.
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3

berduş

30/05/2020, 17:32
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

tekinuygun

30/05/2020, 17:48
(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.

tekinuygun

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

berduş

31/05/2020, 18:19
Iyi calismalar)

ates2014

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

berduş

25/05/2023, 15:43
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
Sayfalar: 1 2 3
AccessTr.neT > Microsoft Access > Access Cevaplanmış Soruları > Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında.