Reverse of BackUp and zip to A drive (1 Viewer)

Hi All,

I have managed to successfully use the following code to create a backup to A drive function but would like to now be able to restore a file from a floppy disc that has been zipped and put it back. ie do the reverse of what the follwing code does. Would someone be so kind as to tell me how to modify this or rewrite it.

Here it is:

Option Compare Database
Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function BackupAndZipitToDriveA()
On Error GoTo Err_BackupAndZipitToDriveA

'This function will allow you to copy a db that is open,
'rename the copied db and zip it up to another folder.

'You must set a reference to the 'Microsoft Scripting Runtime' for the CopyFile piece to work!

'Thanks to Ricky Hicks for the .CopyFile code

Dim fso As FileSystemObject
Dim DB As DAO.Database
Dim sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String
Dim strConnect As String
Dim strConnectFolder As String

strConnect = Mid(DBEngine(0)(0).TableDefs("Blocks1").Connect, Len(";DATABASE=") + 1)
Set DB = OpenDatabase(strConnect)

strConnectFolder = Left(DB.Name, Len(DB.Name) - Len(Dir(DB.Name)))
Set DB = CurrentDb

' This is the path and my file is called pv????
sSourcePath = strConnectFolder
sSourceFile = "VADataFile.mdb"

DoCmd.Hourglass True

'sBackupPath = "A:\"
If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
sBackupPath = "C:\Temp\"
sBackupFile = "VADataFile_" & Format(Date, "ddmmyy") & ".mdb"

Set fso = New FileSystemObject
fso.CopyFile sSourcePath & sSourceFile, sBackupPath & sBackupFile, True
Set fso = Nothing

Dim sWinZip As String
Dim sZipFile As String
Dim sZipFileName As String
Dim sFileToZip As String

sWinZip = "C:\Program Files\WinZip\WinZip32.exe" 'Location of the WinZip program
sZipFileName = Left(sBackupFile, InStr(1, sBackupFile, ".", vbTextCompare) - 1) & ".zip"
sZipFile = sBackupPath & sZipFileName
sFileToZip = sBackupPath & sBackupFile

Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)
Sleep 10000 'ten second pause, 5000 = 5 seconds
DoCmd.Hourglass False
MsgBox "Your backup is nearly complete, please ensure you have a diskette with sufficient space ready in the A:\ drive.", vbInformation, "Vineyard ARKive Backup"
DoCmd.Hourglass True
Name sZipFile As "A:\" & sZipFileName

If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
DoCmd.Hourglass False
Beep
MsgBox "Backup was successful and saved a copy to the A:\ drive." & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed"

Exit_BackupAndZipitToDriveA:
DoCmd.Hourglass False
Exit Function

Err_BackupAndZipitToDriveA:
If Err = 5 Then 'Invalid procedure call or argument
Beep
MsgBox "Disk is full! Can not move the zip file to the A:\ drive. Please move the " & sZipFile & " file to a safe location.", vbCritical, "Vineyard ARKive Backup"
If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
DoCmd.Hourglass False
Exit Function

ElseIf Err = 53 Then 'File not found
Beep
MsgBox "Source file can not be found!" & Chr(13) & Chr(13) & sSourceFile & Chr(13) & Chr(13) & "OR" & Chr(13) & Chr(13) & "You do not have WinZip installed, go to www.winzip.com to download your free evaluation version.", vbCritical, "Vineyard ARKive Backup"
DoCmd.Hourglass False
Exit Function

ElseIf Err = 75 Then 'Disk not ready
Beep
If Dir(sZipFile) <> "" Then Kill sZipFile
If Dir(sFileToZip) <> "" Then Kill sFileToZip
MsgBox "Please insert a diskette in drive A:\ and try again!", vbCritical, "Vineyard ARKive Backup"
DoCmd.Hourglass False
Exit Function

ElseIf Err = -2147024784 Then 'Method 'CopyFile' of object 'IFileSystem3' faild
Beep
MsgBox "File is to large to be zipped onto the A:\ drive!" & vbNewLine & vbNewLine & sZipFile, vbCritical, "Vineyard ARKive Backup"
DoCmd.Hourglass False
Exit Function

ElseIf Err = 58 Then 'backup twice in one day
Beep
MsgBox "The diskette already contains a file with the same name, please insert another diskette or remove the file from the current diskette then try again!", vbCritical, "Vineyard ARKive Backup"
DoCmd.Hourglass False
Exit Function

Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_BackupAndZipitToDriveA
DoCmd.Hourglass False
End If

End Function

Thank you to all, lots and lots

Rachael

I apologise for not being able to do this myself, if I could read the VB language as well as would like there wouldn't be a problem, but unfortunately I can't so if someone could kindly even just give me a clue on how to re-jig the code so I can incorporate a retore function in my database, I would be very appreciative. Thankyou, thankyou, thankyou,

Rachael

Well, after many days and long hours spent trawling all types of databasing forums I think I have a solution;

The main break through came when I downloaded the winzip command line addons, which I didn't use but it had a section for winzip unzip references (ie what the -a means in the zipping code I posted first) Anyway these references also told me the extract ref is -e (makes sense) Incidently when using these make sure you have spaces before and after " -e " else it doesn't work.

Anyway heres my code for those who are interested, this problem would have to be the most unanswered on the net, lots about how to zip but not unzip in this fashion.

BTW - this code is a bit messy coz its just re-jigged, so some of the naming is up the spout, and I had to close and re-open forms to get things happening. Also, this needs to be run from an unbound form (that took three hours to figure out)

OK without further ado;

Option Compare Database
Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function RestoreDriveA()
On Error GoTo Err_RestoreDriveA

'This function will allow you to copy a db that is open,
'rename the copied db and zip it up to another folder.

'You must set a reference to the 'Microsoft Scripting Runtime' for the CopyFile piece to work!

Dim fso As FileSystemObject
Dim DB As DAO.Database
Dim sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String
Dim strConnect As String
Dim strConnectFolder As String

strConnect = Mid(DBEngine(0)(0).TableDefs("Blocks1").Connect, Len(";DATABASE=") + 1)
Set DB = OpenDatabase(strConnect)

strConnectFolder = Left(DB.Name, Len(DB.Name) - Len(Dir(DB.Name)))
Set DB = CurrentDb

DoCmd.Minimize

' This is the path and my file is called pv????
sSourcePath = "A:\"
sSourceFile = "VADataFile.zip"

DoCmd.Hourglass True

'sBackupPath = "A:\"
If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
sBackupPath = "C:\Temp\"
sBackupFile = "VADataFile.zip"

Set fso = New FileSystemObject
fso.CopyFile sSourcePath & sSourceFile, sBackupPath & sBackupFile, True
Set fso = Nothing

Dim sWinZip As String
Dim sZipFile As String
Dim sZipFileName As String
Dim sFileToZip As String
Dim sFileLdb As String

sWinZip = "C:\Program Files\WinZip\winzip32.exe" 'Location of the WinZip program
sZipFileName = Left(sBackupFile, InStr(1, sBackupFile, ".", vbTextCompare) - 1) & ".mdb"
sZipFile = sBackupPath & sBackupFile
sFileToZip = sBackupPath & sZipFileName
sFileLdb = Left(sBackupFile, InStr(1, sBackupFile, ".", vbTextCompare) - 1) & ".ldb"

DoCmd.Close acForm, "Menu"
Call Shell(sWinZip & " -e -o " & sZipFile & " " & sBackupPath, vbHide)
DoCmd.Hourglass False
MsgBox "Your restore will take a few seconds, please wait!", vbInformation, "Vineyard ARKive Restore"
DoCmd.Hourglass True
Sleep 10000 'ten second pause, 5000 = 5 seconds

If Dir(strConnectFolder & sFileLdb) <> "" Then Kill (strConnectFolder & sFileLdb)
Kill strConnect

Name sBackupPath & sZipFileName As strConnectFolder & sZipFileName


If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
DoCmd.Hourglass False
Beep
MsgBox "You have successfully restored you data from the floppy disc.", vbInformation, "Restore Completed"
DoCmd.OpenForm "Menu"

DoCmd.Close acForm, "Restore"

Exit_RestoreDriveA:
DoCmd.Hourglass False
Exit Function

Err_RestoreDriveA:
If Err = 70 Then 'Permission denied
Beep
'incase other forms haven't been closed
MsgBox "Please close Vineyard ARKive and re-open then try again.", vbCritical, "Vineyard ARKive Restore"
If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
DoCmd.Hourglass False
Exit Function

ElseIf Err = 53 Then 'File not found
Beep
MsgBox "Source file can not be found!" & Chr(13) & Chr(13) & sSourceFile & Chr(13) & Chr(13) & "Please ensure you have the correct back up disc.", vbCritical, "Vineyard ARKive Restore"
DoCmd.Hourglass False
Exit Function

ElseIf Err = 75 Then 'Disk not ready
Beep
If Dir(sZipFile) <> "" Then Kill sZipFile
If Dir(sFileToZip) <> "" Then Kill sFileToZip
MsgBox "Please insert your back-up disc and try again!", vbCritical, "Vineyard ARKive Restore"
DoCmd.Hourglass False
Exit Function

ElseIf Err = 71 Then 'Disk not ready
Beep
If Dir(sZipFile) <> "" Then Kill sZipFile
If Dir(sFileToZip) <> "" Then Kill sFileToZip
MsgBox "Please insert your back-up disc and try again!", vbCritical, "Vineyard ARKive Restore"
DoCmd.Hourglass False
Exit Function


Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_RestoreDriveA
DoCmd.Hourglass False
End If


End Function


Also, I had to take out of my backup function the date format in the file name so that the back up zip name on the disc was always the same.

Hope this helps someone!

Rachael