VB - Backup - Compactando com o Winzip

Que tal compactar o seu banco de dados Access (*.mdb) durante a operação de Backup. Quem sabe ele assim vai caber no disquete!! . Vou mostrar uma rotina que faz exatamente isto; é bem simples , mas você pode incrementá-la para fazer além do que eu estou mostrando aqui.

1- Inicie um novor projeto no VB e no formulário padrão insira uma caixa de texto , um botão de comando , uma label , o controle CommonDialog , conforme tela abaixo :

2- Na seção - General Declarations - declara a API que vamos usar:

Private Declare Function ShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd _
As Long) As Long

3- No evento Load do formulário temos o código para configurar o commondialog com parâmetros iniciais.

Private Sub Form_Load()
  cmdlg1.InitDir = "c:\teste"
  cmdlg1.Filter = "Arquivos (*.mdb;*.dbf)|*.mdb;*.dbf |Texto (*.txt)|*.txt"
  cmdlg1.DefaultExt = "*.mdb"
End Sub

4- No evento Click do botão de comando temos o codigo abaixo: ele compacta o banco de dados antes de efetuar a compactação via WInZIP.

Private Sub Command1_Click()

On Error GoTo cmdBackup_Erro

Dim Msg As String
Dim arqDest As String
Dim arqTemp As String

If Len(Text1.Text) = 0 Or Text1.Text = "" Then
  MsgBox "Selecione um arquivo para Backup.", vbCritical, "Backup"
  Exit Sub
End If

arqTemp = "temp.dat"

'Compacta o BD antes do Backup.
Label1.Caption = "Compactando o arquivo " & Text1.Text & " ..."

DBEngine.CompactDatabase Text1.Text, arqTemp, , dbEncrypt
Label1.Caption = "Compactando o arquivo " & Text1.Text & " ... "

FileCopy arqTemp, Text1.Text 'sobrescreve com o arq. compactado.
DoEvents

Label1.Caption = "Arquivo compactado com sucesso!"

arqDest = Dir(Text1.Text) 'obtém o nome do arquivo.

'Altera o destino para um arquivo no drive A: com extensão Zip.
arqDest = "A:\" & Left(arqDest, Len(arqDest) - 3) & "zip"

If BackUp(Text1.Text, arqDest) Then 'executa o backup.
  MsgBox "Operação concluída!", vbInformation, "Backup"
Else
  MsgBox "Operação cancelada.", vbCritical, "Backup"
Exit Sub
End If

 Kill arqTemp 'apaga o arq. temporário.
Label1.Caption = "Arquivo compactado com sucesso!"
Exit Sub

cmdBackup_Erro:
 MsgBox "Erro nº " & Err.Number & vbCrLf & Err.Description, vbCritical, "Backup"

End Sub

5- Agora o código da função - Backup - : Ela chama o WInzip via API com a linha de comando montada : strRet = "C:\Arquivos de Programas\Winzip\Winzip32.exe -a -ef " & """" & arqDestino & """ " & """" & arqOrigem & """"

Function BackUp(arqOrigem As String, arqDestino As String) As Boolean
'É necessário abrir o mdb com acesso exclusivo.
On Error GoTo BackUp_Erro

Dim strRet As String
Dim retonro As Variant

If MsgBox("Insira um disco formatado na unidade A:" & vbCrLf _
 & "Prossegue com o Backup?", vbYesNo, "Efetua BackUp") = vbYes Then

  Label1.Caption = "Iniciando o backup do arquivo " & arqOrigem
  ' Parâmetros de Winzip32.exe:
  ' -a = adiciona arquivos.
  ' -ef = compactação rápida; ex = compactação máxima.
  ' As aspas são necessárias caso o diretório tenha espaços no nome.

  strRet = "C:\Arquivos de Programas\Winzip\Winzip32.exe -a -ef " _
  & """" & arqDestino & """ " & """" & arqOrigem & """"

  retorno = Shell(strRet, vbNormalNoFocus)
  BackUp = True

Else
  BackUp = False
End If

'A linha abaixo deve ser usada com o Arj.exe
'Call MeuShell("C:\Util\Arj.exe a -vva -r -y -i1 " _
'& """" & arqDestino & """ " & """" & arqOrigem & """", 1)

Exit Function

BackUp_Erro:
MsgBox "Erro nº " & Err.Number & vbCrLf & Err.Description, vbCritical, "Backup"

End Function

Voce pode também usar outro compactador como o PKZIP ou o ARJ ( veja no código a linha de comando para usar o ARJ).

Existe um incoveniente nesta rotina ; a janela do WInzip irá surgir e tomar conta do processo , assim se houver necessidade de mais de um disco o WInzip vai solicitar e você vai ter que confirmar. Veja abaixo:

Eu recomendo muito cuidado ao usar esta rotina ! ( para incrementá-la você pode usar outras API´s para verificar se o processo já esta terminado) .

Até a próxima dica ...