Možda ti pomogne ovaj moj kod za kompresiju baze.
Code:
Private Sub Command4_Click()
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 & "\TF - industrijski menadzment\diplomski rad\struktura_kor.mdb" ' apsolutna putanja
fileCompact = disk & DLookup("[PUTANJA]", "AS_KLIJENTI", "[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?", vbYesNo) = 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 izvrsena!", vbInformation, "Obavestenje"
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
Evo je nedostajuća funkcija :
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
[Ovu poruku je menjao Getsbi dana 10.09.2007. u 23:29 GMT+1]