Dim fa As Integer

    Dim errloop

    Dim F As Integer

    Dim fileCompact As String

    Dim disk As String

   

   

      disk = Left(CurDir(), 2) ' odseca prva dva karaktera od putanje zbog promenljivosti diska.

 

   

   

    fileCompact = disk & "\IH\Moja_Baza.mdb"    ' apsolutna putanja

     'fileCompact = disk & DLookup("[PUTANJA]", "Table1", "[SIFRAKOR]=" & var_sifrakor)  ' relativna putanja

     

     

    F = FreeFile

    Open fileCompact For Binary Shared As #F

    SizeBefore = LOF(F)

    Close F

   

    If MsgBox("Zelite li kompresiju podataka?", vbQuestion + vbYesNo, "Potvrda kompresije") = vbYes Then

           

        On Error GoTo Err_Compact

       

        DoCmd.Hourglass True

       

        If FileExists(Mid(fileCompact, 1, Len(fileCompact) - 3) & "bak") Then

            Kill Mid(fileCompact, 1, Len(fileCompact) - 3) & "bak"

        End If

   

        Name fileCompact As Mid(fileCompact, 1, Len(fileCompact) - 3) & "bak"

        DBEngine.CompactDatabase Mid(fileCompact, 1, Len(fileCompact) - 3) & "bak", fileCompact

        DoCmd.Hourglass False

        MsgBox "Kompresija je izvrÅ¡ena!", vbInformation, "Obavijest"

       

   

        F = FreeFile

        Open fileCompact For Binary Shared As #F

        SizeAfter = LOF(F)

        Close F

        PercentCompaction = (SizeBefore - SizeAfter) / SizeBefore

 

    End If

 

    Exit Sub

 

Err_Compact:

 

    For Each errloop In DBEngine.Errors

        MsgBox "Compaction unsuccessful!" & vbCr & _

            "Error number: " & errloop.Number & _

            vbCr & errloop.Description

 

    Next errloop

 

Done:

End Sub

Function FileExists(strFile As String) As Boolean

Dim I As Integer

 

On Error Resume Next

I = Len(Dir(strFile))

FileExists = (Not Err And I > 0)

 

End Function