(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
Forma eklenecek FonksiyonlarOption 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
Buton kodu
Dosya açıksa kapatma FonksiyonuPrivate 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
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.