MS Access

Access'te dosya boyutları zaman içinde şiştikçe şişer, bunun için arada bir Compact&Repair yapmakta fayda var.

Bunu manuel yapabileceğiniz gibi, şu ayarlama ile de her Accessten çıkışta otomatik olarak bu işlemin olmasını sağlayabilirsiniz.

NOT:Dosya boyutunun şişme sebebi şudur:Dosyadan bazı verileri silip başka veriler eklersiniz, ancak arka planda verinin diskte durduğu yer tam anlamıyla silinmez ve dosya boyutuna katkıda bulunmaya devam eder.

Doğrudan Excel manipülasyonu

Şimdi bu örnekte ise, compact işlemini bi takvime bağlamak istiyorsunuz, yani belli saatlerde/günlerde belli Access dosyalarının sıkıştırılmasını istiyorsunuz diyelim.

Neden böyle birşey isteyebilirsiniz, çünkü bir önceki yöntemde veritabanı dosyasından çıkış yaptığınızda compact işlemini hemen o anda yapmaya çalışır ve dosya boyutu büyükse sizi birkaç dakika bekletebilir. Bunun yerine sizin ofiste olmadığınız gece saatleri veya haftasonunda bu işlemin yapılması çok daha verimli olurdu.

Şimdi bunun için nasıl bir Excel VBA kodu yazmak lazım, ona bakalım. Tabi bu örnekte schedule işlemini görmüyoruz, bu işlem nasıl yapılır görmek için buraya tıklayabilirsiniz.

Sub accessleri_compact()

On Error GoTo hata
Dim app As Object
Dim DBler As New Collection 'dosyalara tek tek aynı işlemi yapmamak için bir collectiona atayacağız

Set app = CreateObject("Access.Application")

DBler.Add ("C:\Paylaşım\HG Takip\Aylık Gelişmeler 2016.accdb")
DBler.Add ("C:\Paylaşım\HG Takip\Aylık Gelişmeler - Miy 2016.accdb")
'buraya istendiği kadar dosya eklenebilir

'şimdi de collection içinde geziniyor ve her eleman için aynı işlemi yapıyoruz
For Each d In DBler
    cmp = Left(d, Len(d) - 6) & "_cmp.accdb"
    okmi = app.CompactRepair(d, cmp, False) 'boolean döndürdüğü için böyle yapıyoruz

    If FileLen(d) = FileLen(cmp) Then 'eğer compact sonucunda dosya daha da küçülmediyse, boşuna işlem yapmaya gerek yok,
                                      'sadece yeni üretilen dosyayı silelim, böylece dosyamızın son erişim tarihini de değiştirmemiş oluruz
        Kill cmp
    Else
        Kill d 'orjinal dosyayı siliyoruz
        Name cmp As d 'Kompakt edilen dosyayı orjinal ismi ile rename ediyoruz
    End If

Next d

Set app = Nothing
Exit Sub
hata:
    'Hata durumunda vermek istediğinzi mesjaı veya alacğaınız aksiyonu buraya yazarsınız
End Sub

Neden Excel üzerinden schedule ettik de Access üzerinden etmedik. Accessten de edilebilridi tabi ancak benim Excel'im her zaman açık, Access'i ise sadece ihtiyaç duydukça açıyorum. Schedule işleminin gerçekleşmesi için ise ilgili uygulamanın açık olması gerekir. O yüzden Excel'i tercih ettim. Zaten Excel üzerinden schedule ettiğim daha birçok işlem var, bu da bir yenisi olmuş oldu.

Dolaylı Excel manipülasyonu

Bu bölümde de dolaylı yoldan Excel ile VT sıkıştırma nasıl ona bakalım.

Dolaylıdan kasıt şu, schedule işlemini yine Excelde yapıyor olacağız, ancak sıkıştırma işlemini Excel komutu olarak değil, bunun yerine Access içinde bir makro hazırlayıp, o makroyu çalıştırıcağız.

Sub gelisimdb()

On Error GoTo hata
Dim mydb As Object

Set mydb = GetObject("C:\Paylaşım\HG Takip\GelişimDB.accdb")
mydb.Application.DoCmd.runmacro "MakeTablelar" 'compact işini bu makro yapar-ys
mydb.Application.Quit
Set mydb = Nothing

Exit Sub

hata:
'hata durumunda yapılacklar-ys
End Sub

Yine bu örnekte de Doğrudan yöntemde olduğu gibi Options>Current Database>Compact on close seçeneğine göre bir avantaj var.

Bazen Access'te tabloların, sorguların ve diğer nesnelerin adına toplu şekilde ihtiyaç duyarız. Bunlar için aşağıdaki sorguları çalıştırıabilirsiniz. Bunun için New Query yapıp, hiçbir tablo eklemeden, sağ alt köşedeki SQL düğmesiyle SQL moduna geçin ve direkt bu kodu yapıştırın.

SELECT MsysObjects.Name, MsysObjects.DateCreate, MsysObjects.DateUpdate
FROM MsysObjects
WHERE (((Left$([Name],1))<>"~") AND ((Left$([Name],4))<>"Msys") AND ((MsysObjects.Type)=1))
ORDER BY MsysObjects.Name; 

Sorguları aşağıdaki elde edebilirsiniz

SELECT MsysObjects.Name, MsysObjects.DateCreate, MsysObjects.DateUpdate
FROM MsysObjects
WHERE (((Left$([Name],1))<>"~") AND ((MsysObjects.Type)=5))
ORDER BY MsysObjects.Name;

Makroları da aşağıdaki elde edebilirsiniz

SELECT MSysObjects.Name
FROM MsysObjects
WHERE (Left$([Name],1)<>"~") AND 
(MSysObjects.Type)= -32766
ORDER BY MSysObjects.Name;

Bazen karmaşık tablo ve sorgu yapısını sadeleştirmek için Navigation Pane'deki görünümü Object Type'dan özel bir Grup görünümüne dönüştürebilirsiniz. İşte burdaki grup id'lerine de ihtiyaç duyabilirsiniz. Neden ihtiyaç duyabileceğinizle ilgili örnek ise bir alt konuda bulunuyor.

SELECT MSysNavPaneGroups.Name AS GroupName, MSysNavPaneGroupToObjects.GroupID
FROM MSysNavPaneGroups INNER JOIN (MSysNavPaneGroupToObjects INNER JOIN MSysObjects ON MSysNavPaneGroupToObjects.ObjectID = MSysObjects.Id) ON MSysNavPaneGroups.Id = MSysNavPaneGroupToObjects.GroupID
GROUP BY MSysNavPaneGroups.Name, MSysNavPaneGroupToObjects.GroupID, MSysNavPaneGroups.GroupCategoryID
HAVING (((MSysNavPaneGroups.GroupCategoryID)=3))
ORDER BY MSysNavPaneGroups.Name;

Bazen, mesela büyük tabloların arka arkaya importlanması gereken durumlarda bunları manuel yapmak yerine bir butona atamak ve işten çıkarken butona basmak veya schedule edilmiş bir saatte kendiliğinden çalışacak şekilde ayarlamak iyi bir fikir olmaktadır. Bunun için aşağıdaki gibi bir kod işinizi halledecektir.

Bu kodda ilaveten, eğer klasik Object Type görünümünde çalışmak yerine Group görünümünde çalışıyorsanız yeni importladığınız tabloyu olması gereken gruba taşıyan bir fonksiyon da bulunmaktadır, zira yeni importlanan tablo en aşağıya "isimsiz gruba" düşmektedir.

Önce import koduna bakalım.

Sub import_gerc()

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String
Dim tbldef As TableDef, tbldefs As TableDefs
Dim grupid As Integer
grupid = 1334 'import edeceğim tabloların bulunduğu grubun id numarası

On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

blnHasFieldNames = True
strPathFile = "C:\Paylaşım\HG Takip\Netice Gerçekleşen.xlsx"

strPassword = vbNullString

blnReadOnly = True 'Excel'i readonly açarız, olur da o sırada başkaları bu excelle ilgili işlem yapar diye

' excel dosyasını açar ve sheetleri bir collectiona atarız
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
      strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
      colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' exceli save etmeden kaparız
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

'önce varolan importlu tabloları silelim
Set tbldefs = CurrentDb.TableDefs
For Each tbldef In tbldefs
    If Left(tbldef.Name, 11) = "import_gerç" Then
        DoCmd.DeleteObject acTable, tbldef.Name
    End If
Next tbldef


' Importa başlayalım
For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
            "import_gerç_" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
            colWorksheets(lngCount) & "$"
      Call grubatasi("import_gerç_" & colWorksheets(lngCount), grupid) 'eğer grup görünümünde çalışıyorsa yeni eklenen tablo uncategorized içine düşeceği
      'için onu burdan alıp olması gereken gruba atan fonksiyonu çağırırız
Next lngCount


Set colWorksheets = Nothing

End Sub

Aşağıdaki fonskiyonu uzun aramalar sonucunda burda buldum ve ihtiyacıma göre modifiye ettim. Bu arada bu kod bazı hatalar verdi. mesela recordsetleri deklare kısmında başlarına DAO koymam gerekti. Bir de myID=rs1.Fields(1) olan yer myID=rs1![id] şeklindeydi, onu da bu şekilde değiştirdim. Tablo adını ve grup id'sini parametre olarak verdim.

Function grubatasi(tablo As String, grid As Integer)

    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset2
    
    Dim myID, myPos As Integer

    DoCmd.SetWarnings False
'Get the ObjectID for the dta_SalesAnalysis table
    Set rs1 = CurrentDb.OpenRecordset("SELECT MSysObjects.Name, MSysObjects.ID FROM MSysObjects WHERE MSysObjects.Name='" & tablo & "'")
    rs1.MoveFirst
    myID = rs1.Fields(1)
'Get the LastPosition number from the MSysPaneGroupToObjects table, and increment by 1
    Set rs2 = CurrentDb.OpenRecordset("SELECT MSysNavPaneGroupToObjects.GroupID, " & _
    "Max(MSysNavPaneGroupToObjects.Position) AS LastPos " & _
    "FROM MSysNavPaneGroupToObjects " & _
    "GROUP BY MSysNavPaneGroupToObjects.GroupID " & _
    "HAVING (((MSysNavPaneGroupToObjects.GroupID) = " & grid & ")) " & _
    "ORDER BY Max(MSysNavPaneGroupToObjects.Position);")
    rs2.MoveFirst
    myPos = rs2![LastPos] + 1

'Insert the new record into the MSysNavPaneGroupToObjects table
    DoCmd.RunSQL "INSERT INTO MSysNavPaneGroupToObjects ( Flags, GroupID, Icon, ObjectID, [Position] ) " & _
                 "SELECT 0 AS xFlag, " & grid & " AS xGroup, 0 AS xIcon, " & myID & " AS xObjectID, " & myPos & " AS xPos;"

    Set rs1 = Nothing
    Set rs2 = Nothing

    DoCmd.SetWarnings True


End Function

Yukarda Excel'den bir görevin(sıkıştırma) nasıl schedule edildiğini görmüştük. Bu işi Excelle yapmıştık çünkü Excelimizin her zaman açık olduğunu, Accessin ise her zaman açık olmadığını belirtmiştik, en azından benim dünyamda böyle.

Peki şimdi de şöyle bir senaryomuz olsun: Diyelim ki, network üzerinde veya kendi PC'nizde shared(paylaşılmış) olarak bulunan bir Access dosyanız var, ve çeşitli kullanıcılar bu dosyayı zaman zaman açıyorlar. Ancak bu kullanıcılar malesef bazen dosyayı açık bırakıp işten öyle çıkıyorlar. Bununla beraber sizin yukarda yaptığımız gibi schedule edilmiş bir sıkıştırma işleminiz varsa bu açık dosya üzerinde işlem gerçekleşmeyecektir, çünkü MSDN'nin söylediğine göre sıkıştırma işlemi dosyanın exclusively açılmasını gerektirir, ancak bir dosya başkasında açıksa exclusively açılamaz. Bu durumda yapılması gereken iş basittir: Dosyanın scheduled sıkıştırma öncesinde yine scheduled bir şekilde kapanmasını sağlamak. Bunun için yapılması gereken iş de basittir:

• Bu anaformun Load eventine başka bir formu açmasını söylemek, adı frmTimer olsun
• frmTimer formunu gizlemek
• frmTimer'ın Load eventine TimeInterval girip her 1 saatte Timer eventinin çalışmasını sağlamak
• Timer eventine de kapanmasını istediğiniz saate gelip gelmediğini kontrol edeceğiniz bir kod yazmak(aşağıdaki örnekte gece yarısından hemen önce kapatılacaktır)

Kodlarımız ise aşağıdaki gibi olacak.

Ana form kodu

Private Sub Form_Load()
    DoCmd.OpenForm "Form2"
    Forms!Form2.Visible = False
End Sub

Timer'lı formu kodu

Private Sub Form_Load()
    Me.TimerInterval = 3600000
End Sub
Private Sub Form_Timer()
    If TimeValue(Now()) >= #10:59:00 PM# Then 'saatlik kontrol ettiğimiz için 11:59 sorun olabilir, o yüzden 10:59 yaptım. Bi düşünün bakalım neden?
        Application.Quit
    End If
End Sub

NOT:TimerInterval bilgisini biz VBA kodu olarak girdik ancak design moddayken Formun Properties'ine gelip orada Timer Interval alanına da girebilirdik.

Evet schedule işlemi de bu kadar basit. Tabi illa kapatma işlemi yapmak zorunda değilsiniz, schedule etmek istediğiniz işlem her ne ise onu da yapabilirsiniz. Bazı işlemler dosyanın excluesively açık olmasını gerektirmez, bu nedenle uygulamayı kapatmanız gerekmez, doğrudan işleme geçebilrsiniz.