Option Compare Database
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub Comando22_Click()
Dim SPCL As Long, BPS As Long, NCL As Long, NTC As Long
Dim Copia As String

MsgBox "Introduzca un disquete para realizar la copia", vbInformation, "Copia de seguridad"
Copia = "Copia de Seguridad de Almacén.mdb"
If Dir(Copia) <> "" Then Kill Copia
CreateDatabase Copia, dbLangGeneral
DoCmd.TransferDatabase acExport, "Microsoft Access", Copia, acTable, "Articulos", "Articulos"
DoCmd.TransferDatabase acExport, "Microsoft Access", Copia, acTable, "Movimientos", "Movimientos"
DoCmd.TransferDatabase acExport, "Microsoft Access", Copia, acTable, "Lotes", "Lotes"

'CompactDatabase Copia, "Prov.mdb"
'Kill Copia
'Name "Prov.mdb" As Copia

' ********* Compresión ************

Dim FuncionesZip As ZIPUSERFUNCTIONS
Dim OpcionesZip As ZPOPT
Dim FicherosZip As ZIPnames
FuncionesZip.DLLComment = DevolverDireccionMemoria(AddrOf("FuncionParaProcesarComentarios"))
FuncionesZip.DLLPassword = DevolverDireccionMemoria(AddrOf("FuncionParaProcesarPassword"))
FuncionesZip.DLLPrnt = DevolverDireccionMemoria(AddrOf("FuncionParaProcesarMensajes"))
FuncionesZip.DLLService = DevolverDireccionMemoria(AddrOf("FuncionParaProcesarServicios"))
ruta = CurDir: If Right(ruta, 1) <> "\" Then ruta = ruta & "\"

FicherosZip.s(0) = ruta & Copia


Resultado = ZpInit(FuncionesZip)
Resultado = ZpSetOptions(OpcionesZip)
Resultado = ZpArchive(1, ruta & "Copia de almacen.zip", FicherosZip)

' *********************************

If Dir("a:\" & "Copia de almacen.zip") <> "" Then Kill "a:\" & "Copia de almacen.zip"
GetDiskFreeSpace "A:\", SPCL, BPS, NCL, NTC
libre = SPCL * BPS * NCL
tamaño = FileLen(ruta & "Copia de almacen.zip")
If tamaño > libre Then Beep: MsgBox "Se requieren " & Format(tamaño, "#,##0") & " bytes libres para realizar la copia y el disquete sólo dispone de " & Format(libre, "#,##0") & " bytes. ", vbExclamation: Exit Sub
FileCopy ruta & "Copia de almacen.zip", "a:\" & "Copia de almacen.zip"
Kill ruta & "Copia de almacen.zip"
Kill Copia
MsgBox "Copia finalizada con éxito", vbOKOnly
End Sub