RE: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında. - berduş - 30/05/2020
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
RE: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında. - tekinuygun - 30/05/2020
(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.
RE: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında. - tekinuygun - 31/05/2020
(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.
RE: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında. - berduş - 31/05/2020
Iyi calismalar)
RE: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında. - ates2014 - 25/05/2023
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?
RE: Bağlı Tabloların Bulunduğu Veritabanını Sıkış-onar Yapma Hakkında. - berduş - 25/05/2023
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
|