Create a new class module and paste this source code into it. You should name this class cBackupFiles. If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: cBackupFiles
' Issue # 83
' Requires: Issue #61 - ReverseInstr
' Issue #16 - AddBackslash
' COMPRESS.EXE program that is distributed with
' Visual Basic 5.0 and higher and probably earlier
' versions of VB.
' Written By: C&D Programming Corp.
' Create Date: 3/99
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Public Enum eCompressionType
cmpNone
cmpMicrosoft
cmpZip ' Not currently supported
End Enum
Private meCompType As eCompressionType
Private msCompressionLocation As String ' the loation of the COMPRESS.EXE file
Public Property Let CompressionType(eCompType As eCompressionType)
meCompType = eCompType
End Property
Public Property Get CompressionType() As eCompressionType
CompressionType = meCompType
End Property
Public Property Get MicrosoftCompressionEXELocation() As String
MicrosoftCompressionEXELocation = msCompressionLocation
End Property
' This routine uses the COMPRESS.EXE program that is distributed with
' Visual Basic 5.0 and higher (I'm pretty sure it is distributed with
' earlier versions as well).
'
' This routine expects either the path that contains the compress.exe program
' of a full path and filename of what you have renamed the compress.exe program
' to.
'
' For example:
' MicrosoftCompressionEXELocation = App.Path
' or
' MicrosoftCompressionEXELocation = App.Path & "\COMPRESS.EXE"
'
' If the file can not be found in the path or filename you have specified it
' will raise an error.
'
Public Property Let MicrosoftCompressionEXELocation(ByVal sLocation As String)
' if the length is shorter than the filename then assume we are just
' receiving a path name. Not the best assumption, but not a bad one
' either.
If Dir(sLocation) <> "" Then ' we found the file so let's get outta here.
msCompressionLocation = sLocation
Exit Property
End If
If Len(sLocation) < 12 Then
sLocation = sLocation & "\compress.exe"
End If
If Right(sLocation, 12) <> "compress.exe" Then
msCompressionLocation = sLocation & "\compress.exe"
Else
msCompressionLocation = sLocation
End If
If Dir(msCompressionLocation) = "" Then
Err.Raise 53, "MicrosoftCompressionEXELocation", "Could not locate the file " & msCompressionLocation
End If
End Property
'
' This backup routine will overwrite any existing files. A future issue
' might discuss checking for overwriting destination files.
'
'
' If no error is raised from this routine it can be assumed that the
' backup was successful.
'
Public Sub BackupFile(sSourceFile As String, sDestinationPath As String)
Dim sFilename As String
Dim lBackPos As Long
On Error GoTo Handler
' make a backup of the data files.
If Dir(sDestinationPath, vbDirectory) = "" Then
On Error Resume Next
MkDir sDestinationPath
If Err Then
Err.Raise Err.Number, "BackupFile", "Could not create or find the directory " & sDestinationPath
End If
On Error GoTo Handler
End If
' make sure the source file exists. If it doesn't then complain to the caller.
If Dir(sSourceFile) = "" Then
Err.Raise 53, "BackupFile", "Could not find the file " & sSourceFile
End If
Select Case CompressionType
Case cmpNone
' find filename so we can tell FileCopy what filename to copy the
' file to.
lBackPos = ReverseInstr(sSourceFile, "\", vbBinaryCompare)
If lBackPos = 0 Then
Err.Raise 53, "BackupFile", "Could not locate filename in " & sSourceFile
End If
sFilename = Mid$(sSourceFile, lBackPos + 1)
FileCopy sSourceFile, AddBackslash(sDestinationPath) & sFilename
Case cmpMicrosoft
LZFileCopy sSourceFile, AddBackslash(sDestinationPath)
Case cmpZip
' Add Zip routines here...
End Select
Exit Sub
Handler:
Err.Raise Err.Number, "BackupFile", Err.Description
End Sub
'
' This routine uses the COMPRESS.EXE program that is distributed with
' Visual Basic 5.0 and higher (I'm pretty sure it is distributed with
' earlier versions as well). We could not locate any API calls that
' provide the interface to a library of routines that are implemented
' in COMPRESS.EXE
'
Private Sub LZFileCopy(sSourceFile As String, sDestinationPath As String)
Dim lRet As Long
On Error GoTo Handler
lRet = Shell(MicrosoftCompressionEXELocation & " -r " & sSourceFile & " " & sDestinationPath, vbHide)
Exit Sub
Handler:
Err.Raise Err.Number, "LZFileCopy", Err.Description
End Sub
Private Sub Class_Initialize()
CompressionType = cmpNone
End Sub