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

acar6783

Altın Üye
Katılım
6 Temmuz 2008
Mesajlar
1,704
Beğeniler
18
Excel Vers. ve Dili
OFFİCE 2007- TÜRKÇE
#1
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?
 
Katılım
31 Aralık 2005
Mesajlar
3,712
Beğeniler
116
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
#2
... 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

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

Altın Üye
Katılım
6 Temmuz 2008
Mesajlar
1,704
Beğeniler
18
Excel Vers. ve Dili
OFFİCE 2007- TÜRKÇE
#3
Örnek dosya hazırladım fakat uyarlama işlemini gerçekleştiremedim.
 

Ekli dosyalar

Katılım
31 Aralık 2005
Mesajlar
3,712
Beğeniler
116
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
#4
Aşağıdaki proseduru test edin.

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

Altın Üye
Katılım
6 Temmuz 2008
Mesajlar
1,704
Beğeniler
18
Excel Vers. ve Dili
OFFİCE 2007- TÜRKÇE
#5
Bir dosyada hatasız işlem yapıyorum fakat diğer dosyada
1552639819238.png
hatası alıyorum
 

acar6783

Altın Üye
Katılım
6 Temmuz 2008
Mesajlar
1,704
Beğeniler
18
Excel Vers. ve Dili
OFFİCE 2007- TÜRKÇE
#6
İlgili access dosyası aslında mdb uzantılı fakat dosyayı açıp kaydetmeye çalıştığımda da hata veriyor.
 

acar6783

Altın Üye
Katılım
6 Temmuz 2008
Mesajlar
1,704
Beğeniler
18
Excel Vers. ve Dili
OFFİCE 2007- TÜRKÇE
#8
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

.
Kod:
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ü.
(y)(y)
 
Katılım
9 Mart 2005
Mesajlar
2,455
Beğeniler
77
Excel Vers. ve Dili
Excel 2003-tr
#9
Kod:
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
7,061
Beğeniler
475
Excel Vers. ve Dili
32 Bit 2010 - İngilizce
#10
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?

.
 
Katılım
9 Mart 2005
Mesajlar
2,455
Beğeniler
77
Excel Vers. ve Dili
Excel 2003-tr
#11
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
7,061
Beğeniler
475
Excel Vers. ve Dili
32 Bit 2010 - İngilizce
#12
Bilgi için teşekkürler Veysel Bey.

.
 
Üst