excel ile access dosyasını sıkıştırma

[acar6783]

Hayırlı günler,
Excelden her access dosyasına veri atıp sildiğimde accesin dosya boyutu şişiyor. Bir ara 90mb'a kadar çıktı. Accesi açıp sıkıştır-onar yaptığımda 236kb' düştü.
Bu işlemi ben excel ile yapabilirmiyim?

 

[Zeki Gürsoy]

... Accesi açıp sıkıştır-onar yaptığımda 236kb' düştü. Bu işlemi ben excel ile yapabilirmiyim?

Elbette. Aşağıda parametrik bir metot hazırladım, onu kullanın.
SourceConnection : Boyutu büyük olan mdb ADO Connection String,
Destconnection : Boyutu küçük olan (hedef) mdb ADO Connection String

Sub CompactDatabase(ByVal SourceConnection As String, ByVal Destconnection As String)
    Dim jro As Object
    
    Call CreateObject("JRO.JetEngine").CompactDatabase(SourceConnection, Destconnection)
    
    'Kill "eski mdb"
    'Name "yeni mdb" As "eski mdb"
End Sub

 

[acar6783]

Örnek dosya hazırladım fakat uyarlama işlemini gerçekleştiremedim.

 

[Zeki Gürsoy]

Aşağıdaki proseduru test edin.

Sub Test()
    cn1 = "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Veritabanı.mdb"
    cn2 = "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Veritabanı_2.mdb"
    
    Call CreateObject("JRO.JetEngine").CompactDatabase(cn1, cn2)
    
    Kill ThisWorkbook.Path & "\Veritabanı.mdb"
    Name ThisWorkbook.Path & "\Veritabanı_2.mdb" As ThisWorkbook.Path & "\Veritabanı.mdb"
End Sub

 

[acar6783]

Bir dosyada hatasız işlem yapıyorum fakat diğer dosyada

hatası alıyorum

 

[acar6783]

İlgili access dosyası aslında mdb uzantılı fakat dosyayı açıp kaydetmeye çalıştığımda da hata veriyor.

 

[Haluk]

Anlaşılan sizin MDB dosyası biraz bozulmuş gibi..... bir şey fark eder mi bilmiyorumama, isterseniz bir de aşağıdaki linkte yer alan kodu deneyin.

https://www.excel.web.tr/threads/mdb-dosya-bueyuekluegue.177083/post-971071

.

 

[acar6783]

Anlaşılan sizin MDB dosyası biraz bozulmuş gibi..... bir şey fark eder mi bilmiyorumama, isterseniz bir de aşağıdaki linkte yer alan kodu deneyin.

https://www.excel.web.tr/threads/mdb-dosya-bueyuekluegue.177083/post-971071

.

Sub Test()
    cn1 = "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Veritabanı.mdb"
    cn2 = "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & ThisWorkbook.Path & "\Veritabanı_2.mdb"
    
    Call CreateObject("JRO.JetEngine").CompactDatabase(cn1, cn2)
    
    Kill ThisWorkbook.Path & "\Veritabanı.mdb"
    Name ThisWorkbook.Path & "\Veritabanı_2.mdb" As ThisWorkbook.Path & "\Veritabanı.mdb"
End Sub
Sub Test2()
    'Haluk - 01/01/2019
    '
    Dim DB As Object
    Dim daoDBEngine As Object
    Dim MyDb As String, NewDb As String
    Dim Len1 As Long, Len2 As Long
  
    On Error Resume Next
        Set daoDBEngine = CreateObject("DAO.DBEngine")
        Set daoDBEngine = CreateObject("DAO.DBEngine.36")
        Set daoDBEngine = CreateObject("DAO.DBEngine.120")
    On Error GoTo 0
  
    MyDb = "C:\VeriTabanı\Veritabanı.mdb"
    NewDb = "C:\VeriTabanı\Veritabanı2.mdb"
  
    Len1 = FileLen(MyDb)
  
    If Dir(MyDb) = Empty Then
        MsgBox MyDb & " bulunamadi, kodlar sonlandirilacak ...."
        Exit Sub
    End If
  
    If Not Dir(NewDb) = Empty Then Kill NewDb
  
    daoDBEngine.CompactDatabase MyDb, NewDb
  
    Len2 = FileLen(NewDb)
  
    MsgBox "Orjinal dosya boyutu : " & Format(Len1, "#,##0.00") & " byte" & vbCrLf & vbCrLf _
           & "Yeni dosya boyutu  : " & Format(Len2, "#,##0.00") & " byte" & vbCrLf & vbCrLf _
           & "Fark : " & Format((Len2 - Len1), "#,##0.00") & " byte"
    Kill MyDb
    Name NewDb As MyDb
    Set daoDBEngine = Nothing
End Sub

Bu kodlarla çözüldü. 33mb'dan 2mb'a düştü.

 

[veyselemre]

Sub testCompactAccdb()
    CreateObject("WScript.Shell").Run ThisWorkbook.Path & "\Veritabani.accdb /compact"
End Sub
Sub testCompactMdb()
    ChDir "C:\Program Files (x86)\Microsoft Office\Office14\"
    CreateObject("WScript.Shell").Run "MSACCESS " & ThisWorkbook.Path & "\Veritabanı.mdb /compact"
End Sub

 

[Haluk]

Veysel Bey, denemeden yazdığım için baştan özür dileyerek sormak istedim.....

Yukarıda 9 No'lu mesajınızdaki "testCompactMdb" isimli prosedür, muhtemelen bilgisayarda MS Access yüklü değilse çalışmayacaktır.

"testCompactAccdb" isimli prosedürün çalışması için de MS Access programının yüklü olması gerekir mi?

.

 

[veyselemre]

Veysel Bey, denemeden yazdığım için baştan özür dileyerek sormak istedim.....

Yukarıda 9 No'lu mesajınızdaki "testCompactMdb" isimli prosedür, muhtemelen bilgisayarda MS Access yüklü değilse çalışmayacaktır.

"testCompactAccdb" isimli prosedürün çalışması için de MS Access programının yüklü olması gerekir mi?

.

Aynen ikisine de gerekir.

 

[Haluk]

Bilgi için teşekkürler Veysel Bey.

.