Dok cekamo da Daks posalje resenje koje je nasao, evo jedne mogucnosti da se odradi backup access baze (MDB ili ADP). resenje je testirano na 2002 veziju, verujem da radi i na 2000. Za 97 mislim da ne moze, nije provereno. Resenje je u stvari prevedeni primer iz Help-a. Ovo resenje je zgodno za slucajeve kada je aplikacija odvojena od fajla sa podacima (a 99% slucajeva bi trebalo da budu tako poatavljeni). Iz aplikacije moze da se pozove prilozena funkcija koja ce da kreira kopiju na zadatom mestu (floppy, CD ili hard drajv, na mrezi ili lokalno).
Code:
Function RepairDatabase(strSource As String, _
strDestination As String) As Boolean
'Namena: Pravi kompaktovanu kopiju date Access MDB ili ADP baze podataka
'Ulazne vrednosti: imena izvornog fajla i kopije, ukljucujuci path
'Access verzije: 2000+
'Uslovi: - ne moze se primeniti na tekucu bazu (MDB u kome se funkcija nalazi)
' - ne moze se primeniti na otvorenu bazu podataka
' - ne sme se zadati kopije koje vec postoji, svaka kopija mora da ima zasebno ime
'Primeri pozivanja:
'RepairDatabase(strsource:=currentdb.Name,strdestination:="C:\TEMP\MyBackUp")
' - daje Error 7846, pokusaj kompaktovanja tekuceg fajla
'repairdatabase("C:\Documents and Settings\mladend\Desktop\Scrap Book\DvaDatuma.mdb","C:\TEMP\MyBackUp")
' vraca rezultat:True, znaci uspeo compact => back up kopija kreirana
'True
'Ponovanm poziv sa istim argumentima vraca gresku 7847 "bacup file exists"
'
On Error GoTo error_handler
Debug.Print "Source:", strSource
Debug.Print "Destination:", strDestination
' Kompaktuj i popravi bazu. CompactRepair metod vraca
' vrednost TRUE ili FALSE, ako operacija uspe ili ne uspe
RepairDatabase = _
Application.CompactRepair( _
LogFile:=True, _
SourceFile:=strSource, _
DestinationFile:=strDestination)
EXIT_HERE:
' Reset the error trap and exit the function.
On Error GoTo 0
Exit Function
' Return False if an error occurs.
error_handler:
RepairDatabase = False
Select Case Err.Number
Case Else
MsgBox prompt:="Error " & Err.Number & vbCrLf & Err.Description, _
Title:="ComapctMDB() --> ERROR"
End Select
Resume EXIT_HERE
End Function