[AccessD] How's this

For the power of a framework...

I wanted to build a little backup utility.  My framework has zip / unzip
built in.  The code to zip a set of files held in a table becomes:

Private Sub cmdZip_Click()
On Error GoTo Err_cmdZip_Click
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
Dim lngIDBus As Long
    
    lngIDBus = txtIDBus.Value
    strSQL = "SELECT * " & _
                "FROM tblBackupFile " & _
                "WHERE BUF_IDBUS = " & lngIDBus
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL)
    With rst
        While Not .EOF
            cfw.cZip.AddFileSpec !BUF_FileSpec
            .MoveNext
        Wend
    End With
    cfw.cZip.ZipFile = txtZipFileName.Value
    cfw.cZip.BasePath = txtDirSpec.Value
    cfw.cZip.Zip
Exit_cmdZip_Click:
On Error Resume Next
    If Not (rst Is Nothing) Then rst.Close: Set rst = Nothing
    If Not (db Is Nothing) Then db.Close: Set db = Nothing
Exit Sub
Err_cmdZip_Click:
        MsgBox Err.Description, , "Error in Sub
Form_frmBackupSet.cmdZip_Click"
        Resume Exit_cmdZip_Click
    Resume 0    '.FOR TROUBLESHOOTING
End Sub

There are a pair of tables, one that allows you to select a name for the
backup set and a destination dir to place the zip file.  The other is a
child that holds the names of files to include in the zip file (backup).  A
form/subform allows you to create the name/dest dir and find and store the
files to zip.

The button to find the dir is:

Dim fclsFileOpen As clsFileOpen

Private Sub cmdFindDir_Click()
On Error GoTo Err_cmdFindDir_Click
Static strLastPath As String
   
    If Len(strLastPath) = 0 Then
        strLastPath = ""
    End If
    fclsFileOpen.GetDirectory "Select Directory to Backup To", strLastPath
    txtDirSpec = fclsFileOpen.pDirectory
    Me.Dirty = False

Exit_cmdFindDir_Click:
Exit Sub

Err_cmdFindDir_Click:
   Select Case Err
   Case 0      'insert Errors you wish to ignore here
      Resume Next
   Case Else   'All other errors will trap
      Beep
      MsgBox Err.Description, , "Error in function
Form_sfrm_ProductFiles.cmdFindDir_Click"
   Resume Exit_cmdFindDir_Click
   End Select
   Resume 0 'FOR TROUBLESHOOTING
End Sub

The subform code:

Dim fclsFileOpen As clsFileOps
Private Sub Form_Open(Cancel As Integer)
    Set fclsFileOpen = New clsFileOps
End Sub
'Comments  :
'Parameters:
'Created by: Colby Consulting
'Created   : 6/19/98 12:50:49 PM
Private Sub cmd_FindPCFile_Click()
On Error GoTo Err_cmd_FindPCFile_Click
Static strLastPath As String
   
   If Len(strLastPath) = 0 Then
      strLastPath = ""
   End If
    fclsFileOpen.FFFindFile "Select File to backup", strLastPath
   txtFileSpec = fclsFileOpen.FFSpec
   Me.Dirty = False

Exit_cmd_FindPCFile_Click:
Exit Sub

Err_cmd_FindPCFile_Click:
   Select Case Err
   Case 0      'insert Errors you wish to ignore here
      Resume Next
   Case Else   'All other errors will trap
      Beep
      MsgBox Err.Description, , "Error in function
Form_sfrm_ProductFiles.cmd_FindPCFile_Click"
   Resume Exit_cmd_FindPCFile_Click
   End Select
   Resume 0 'FOR TROUBLESHOOTING
End Sub

All of the code to do everything are services of the framework.

John W. Colby
www.ColbyConsulting.com 

Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/