Predmet:Re: Razika između Last i Max funkcije
Tražio sam malo sa Googlom i naÅ¡ao slijedeču funkciju koja je interesantna jer sa njome se može:
1) Izraditi backup kopiju baze
2) Napraviti kompakt baze i preimenovati je
3) Napraviti samo kompakt baze
PreuzmiIzvorni kôd (vbnet):Public Sub Compact_MDB(()
Dim PutanjaBaze As String, staroImeBaze As String, novoImeBaze As String, DbBackup As String
Dim Response As Integer, fs As Object
PutanjaBaze = Application.CurrentProject.Path
staroImeBaze = "Proces_be" & ".mdb" ' ovdje staviti ime svoje baze, putanja nije potrebna
novoImeBaze = "Proces_BeNew" & ".mdb"
DbBackup = Mid(staroImeBaze, 1, Len(staroImeBaze) - 4) & "_" & Format(Date, "mmddyy") & ".mdb"
Response = MsgBox("Želite li napraviti Back-Up kopiju ove baze koja e se zvati " & vbCrLf & "'" & DbBackup & "'", vbYesNo, "Continue")
If Response = vbYes Then
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile PutanjaBaze & "\" & staroImeBaze, PutanjaBaze & "\" & DbBackup
Set fs = Nothing
Else
If MsgBox("Želite li uraditi kompakt ove baze i preimenovati je kao " & vbCrLf & "'" & novoImeBaze & "'", vbYesNo, "Continue") = vbYes Then
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile PutanjaBaze & "\" & staroImeBaze, PutanjaBaze & "\" & DbBackup
DBEngine.CompactDatabase PutanjaBaze & "\" & DbBackup, PutanjaBaze & "\" & novoImeBaze
Kill PutanjaBaze & "\" & DbBackup
Set fs = Nothing
Else
If MsgBox("Želite li uraditi samo kompakt ove baze?", vbYesNo, "Continue") = vbYes Then
CommandBars("Menu Bar"). _
Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and repair database..."). _
accDoDefaultAction
Else
DoCmd.CancelEvent
End If
End If
End If
End Sub
Pozdrav
Ovaj post je ureden
2
puta. Posljednja izmjena 22.09.2011 14:24 od strane pmiroslav.