Back up and zip code from ghudson (1 Viewer)

[David b]

Further to my last post I happened to look in C:\temp and the copy and zip files were sitting there.
Any Ideas ?
David b

 

[ghudson]

Not sure why it will not work for you but I just tested this five times without fail
for copying a db, renaming it, zipping it and copying it to my A drive.

Option Compare Database
Option Explicit
    
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 sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String
    
sSourcePath = "C:\Testing\"
sSourceFile = "TestDB.mdb"
    
'sBackupPath = "A:\"
If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
sBackupPath = "C:\Temp\"
sBackupFile = "BackupDB_" & Format(Date, "mmddyyyy") & "_" & Format(Time, "hhmmss") & ".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)
    
Name sZipFile As "A:\" & sZipFileName
    
Beep
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & "A:\" & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed"
    
If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
    
Exit_BackupAndZipitToDriveA:
    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
        If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
        Exit Function
    ElseIf Err = 53 Then 'File not found
        Beep
        MsgBox "Source file can not be found!" & vbNewLine & vbNewLine & sZipFileName, vbCritical
        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
        Exit Function
    Else
        MsgBox Err.Number & " - " & Err.Description
        Resume Exit_BackupAndZipitToDriveA
    End If
    
End Function

 

[David b]

Ok tried the code you kindly sent. Error saying Source file can not be found -BackupDB (date ref) zip.

Could it be that because I am backing up a 2mb file the zipping routine has not finished when the code tries to copy to A:\ ?

Maybe it needs a pause put in to allow time for the zipping to happen ?

David b

 

[ghudson]

Try this...I added a DoEvents before the file rename step and I also added an
error trap incase the drive A does not have a diskette loaded. Works okay for
me and my test file to zip is 3 megs.

Option Compare Database
Option Explicit
    
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 sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String
    
sSourcePath = "C:\Temp\"
sSourceFile = "TestDB.mdb"
    
'sBackupPath = "A:\"
If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
sBackupPath = "C:\Temp\"
sBackupFile = "BackupDB_" & Format(Date, "mmddyyyy") & "_" & Format(Time, "hhmmss") & ".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)
    
DoEvents
    
Name sZipFile As "A:\" & sZipFileName
    
If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)

Beep
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & "A:\" & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed"
    
Exit_BackupAndZipitToDriveA:
    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
        If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
        Exit Function
    ElseIf Err = 53 Then 'File not found
        Beep
        MsgBox "Source file can not be found!" & vbNewLine & vbNewLine & sZipFileName, vbCritical
        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 a diskette in drive A:\ and try again!", vbCritical
        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
        Exit Function
    Else
        MsgBox Err.Number & " - " & Err.Description
        Resume Exit_BackupAndZipitToDriveA
    End If
    
End Function

HTH

 

[David b]

Still got the same prob. The 2 files (backup and backup.zip) are sitting in C:\temp as expected when I check.
David b

 

[David b]

Someone suggested this could be the problem. What do you think ?
David b

> Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)
> Name sZipFile As "A:\" & sZipFileName

>I guess this is what's causing the error, is it? The shell is >running in a
>separate process and not reporting back when it's finished.

 

[ghudson]

That is why I added the DoEvents command in the previous post. It should allow the call to WinZip to process and then move the file to the A drive. Did you try my last code posting where I made more changes?

Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)
DoEvents
Name sZipFile As "A:\" & sZipFileName

 

[David b]

Yep, tried your latest code, still the same.
David b

 

[David b]

At last I`ve got it to work. Not very tidy but I put a message box in which stops the code until the yes button is pressed

Call Shell(sWinZip & " -a " & sZipFile & " " & sFileToZip, vbHide)
DoEvents
intreply = MsgBox("Waiting?", vbYesNo)

If intreply = vbYes Then

Name sZipFile As "A:\" & sZipFileName
End If

Must be a neater way of doing this ?
David b

 

[ghudson]

I had thought about the message box but I prefer not to use one for this situation.
Earlier you mentioned pausing the function. I have added the Sleep function to
my code below. I have it set for a ten second pause. Play around with the
Sleep setting and see if this works better for you.

Option Compare Database
Option Explicit
    
[COLOR=blue]Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)[/COLOR]
    
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 sSourcePath As String
Dim sSourceFile As String
Dim sBackupPath As String
Dim sBackupFile As String
    
sSourcePath = "C:\Temp\"
sSourceFile = "Testing.mdb"
    
'sBackupPath = "A:\"
If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
sBackupPath = "C:\Temp\"
sBackupFile = "BackupDB_" & Format(Date, "mmddyyyy") & "_" & Format(Time, "hhmmss") & ".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)
    
[COLOR=blue]Sleep 10000[/COLOR] 'ten second pause, 5000 = 5 seconds
    
Name sZipFile As "A:\" & sZipFileName
    
If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)

Beep
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & "A:\" & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed"
    
Exit_BackupAndZipitToDriveA:
    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
        If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile)
        Exit Function
    ElseIf Err = 53 Then 'File not found
        Beep
        MsgBox "Source file can not be found!" & vbNewLine & vbNewLine & sZipFileName, vbCritical
        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 a diskette in drive A:\ and try again!", vbCritical
        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
        Exit Function
    Else
        MsgBox Err.Number & " - " & Err.Description
        Resume Exit_BackupAndZipitToDriveA
    End If
    
End Function

HTH

 

[David b]

We are getting there now. Your sleep funtion does the trick.

I think I prefer the msg box method though. A chance to remind the user to put a disc in the drive. and it seems (to the user) as though something is happening during the 5 or 10 seconds .

Anyway I`m very grateful for your help on this one, hope I can return the favour sometime

David b

 

[scouser]

Paste Code

Guy's, way to advanced for me!! I have designed a DB for my brothers company. I want to add some sort of back-up facility. Maybe a command button on a custom menu so that when clicked it saves the entire DB. Could the code in this thread be implemented do do the job?
Excuse my ignorance,
Phil.

 

[ghudson]

Try it and see...

Public Function BackupAndZipit() 

'This function will allow you to copy a db that is open, 
'rename the copied db and zip it up to anther 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 sSourcePath As String 
Dim sSourceFile As String 
Dim sBackupPath As String 
Dim sBackupFile As String 

sSourcePath = "C:\Database\" 
sSourceFile = "MyDB.mdb" 
sBackupPath = "C:\Database\Backups\" 
sBackupFile = "BackupDB_" & Format(Date, "mmddyyyy") & "_" & Format(Time, "hhmmss") & ".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) 

Beep 
MsgBox "Backup was successful and saved @ " & Chr(13) & Chr(13) & sBackupPath & Chr(13) & Chr(13) & "The backup file name is " & Chr(13) & Chr(13) & sZipFileName, vbInformation, "Backup Completed" 

If Dir(sBackupPath & sBackupFile) <> "" Then Kill (sBackupPath & sBackupFile) 

End Function

 

[scouser]

Implement

Mr. Hudson, how would I implement the code within my database?
I am Mr. Novice so be gental with me. I feel my DB needs this facility and would very much appreciate your assistance.
Many thanks,
Phil.

 

[ghudson]

Assign my code to a command button within your form. You will need to change these three strings:

sSourcePath = "C:\Database\" 'the path to your db
sSourceFile = "MyDB.mdb" 'the db name
sBackupPath = "C:\Database\Backups\" 'the path to where you want the backups to go

Ensure that you set a reference to the 'Microsoft Scripting Runtime' for the CopyFile piece to work!

You must have WinZip installed and the sWinZip string must point to where it is located
sWinZip = "C:\Program Files\WinZip\WinZip32.exe"

I believe that is it for this code is pretty straight forward and easy to use for only a few parts have to be changed in order for it to work on your PC.

HTH

 

[David b]

He must have gone to the pub <bg>

copy the code and paste it into a new module.

These 2 lines -
sSourcePath = "C:\Database\"
sSourceFile = "MyDB.mdb"
- need to be changed to match your set up.

Then you need a button on an unbound form with something like this in the onclick event - Call BackupAndZipit

If you are having problems getting the path right try this.
Go to the file you want to back up in explorer. right click and select create shortcut. Go to the shortcut and, right click and select properties. In the shortcut tab you will be able to copy the path.

HTH
David b

 

[biskra]

sorry for my bad english
can someone put an exemple.and what we must do when we use winrar?

 

[scouser]

Erm!!!!

I created a new form and added a command button. I created a new module then a macro. The macro runs the function: BackupAndZipit() I assigned this macro to the OnClick Event:

I get the following error when I click the command button:

Compile Error User-Defined type not defined?
fso As FileSystemObject

Should I give up????
& what does this mean?
'You must set a reference to the 'Microsoft Scripting Runtime' for the CopyFile piece to work!
Sorry to be a burden!!!!
Cheers,
Phil.

 

[David b]

Don`t give up.

With a form open, press control and G - takes you to the debug window.
Click Tools then References. Scroll down the list till you find Microsoft Scripting Runtime. Tick the box.
Close everything and try again

HTH
David b

 

[scouser]

Thanks

Will give that suggestion a try.
Thanks for your patience.
Phil.