Criar uma aplicação para fazer backup das pastas pessoais

Um colega meu pediu-me recentemente para lhe criar uma macro no Outlook que lhe permitisse fazer backup só de um pasta nas pastas pessoais.
Só para vos dar um exemplo, os meus colegas guardam as mensagens referentes a clientes em pastas pessoais com o respectivo nome do cliente e quando terminam um trabalho gostam de guardar num CD toda a informação relativa a um cliente (ficheiros, documentos, apresentações e mensagens de correio electrónico).
Existem alternativas:

• poderiam utilizar o Arquivo automático (explicado neste artigo), mas esta ferramenta é pouco compreendida pelos utilizadores menos experientes…;

• poderiam utilizar o add-in da Microsoft Cópia de segurança de pastas pessoais (explicado neste artigo), mas esta ferramenta faz backup de todas as pastas pessoais…

• poderiam utilizar o Importar/Exportar, mas nem sempre esta ferramenta é clara e os utilizadores tem a tendência de exportar para formatos mais familiares (Excel…) o que depois causa grandes transtornos na importação…

• poderiam criar uma nova pasta pessoal (explicado neste artigo), copiar a pasta do cliente e depois guardar o ficheiro .pst no CD, mas esta solução (que eu considero a melhor) quando explicada na integra é confusa para os utilizadores.

Aproveitando esta última solução criei um pequeno formulário com VBA para agilizar este processo.

Funcionamento:
Pasta onde armazenar o backup (Windows) – É o local onde vai ser guardado o ficheiro backup.pst. O botão Pasta abre um explorador para facilitar a escolha da pasta.

Pasta origem do backup – É a pasta pessoal (personal folder) que prentedemos fazer backup. O botão Escolher pasta abre um “explorador” de pastas pessoais para facilitar a escolha da pasta.

Destino do backup – É a pasta onde vai ser guardado o backup. O botão Escolher pasta abre um “explorador” de pastas pessoais para facilitar a escolha da pasta.

O botão Fazer Backup adiciona uma nova pasta pessoal⁽¹⁾, executa o processo de cópia⁽²⁾, fecha a pasta pessoal⁽³⁾, e fecha o Outlook⁽⁴⁾.

Explicando um pouco melhor passo-a-passo:
1 Quando se selecciona a pasta do Windows onde fica o ficheiro (pst) este é adicionado ao Outlook como sendo uma nova Pasta Pessoal. Esta nova pasta pessoal deve tem que ser o Destino do backup.

2 Quando escolhidas as pastas de origem/destino a cópia é efectuada.

3 Depois de ter sido copiada a pasta (do cliente) a Pasta Pessoal no Outlook é fechada, já que o backup está efectuado.

4 Para poder copiar/renomear/mover o ficheiro .pst originado pelo backup o Outlook tem que ser fechado, se não surge a mensagem de erro a informar que o ficheiro está bloqueado por outro processo.
 

O Desenvolvimento
Explicando o formulário é muito básico, 3 caixas de texto, 3 labels e 4 botões…
O segredo está por trás dos botões:


Código

    Dim myOlApp As New Outlook.Application

    Dim myNameSpace As Outlook.NameSpace

    Dim myOrigFolder As Outlook.MAPIFolder

    Dim myDestFolder As Outlook.MAPIFolder

    Dim myOrig2Folder As Outlook.MAPIFolder

    Dim myDest2Folder As Outlook.MAPIFolder

    Dim myNewFolder As Outlook.MAPIFolder

Private Sub cmdFileBck_Click()

On Error Resume Next

Const ssfDRIVES = 17

Dim oShell, oFolder, oFolderItem, fso, selected

Set fso = CreateObject("Scripting.FileSystemObject")

Set oShell = CreateObject("Shell.Application")

Set oFolder = oShell.BrowseForFolder(0, "Choose a folder", 0, ssfDRIVES)

Set oFolderItem = oFolder.Items.Item

dirname = fso.GetFolder(oFolderItem.Path)

TextBox3.Text = dirname

If TextBox3.Text <> "" Then

Call CreatePST

Else

End If

If Err.Number <> 0 Then

pergunta = MsgBox("Ainda não escolheu uma pasta. Quer fechar?", vbYesNo, "Aviso")

If pergunta = 7 Then       ' "não"

Else                       ' "sim"

wscript.Quit

End If

End If

End Sub

Private Sub cmdpick1_Click()

On Error Resume Next

    Set myNameSpace = myOlApp.GetNamespace("MAPI")

    Set myOrigFolder = myNameSpace.PickFolder

    Set myOrig2Folder = myOrigFolder

    TextBox1.Text = myOrigFolder

If Err.Number <> 0 Then

Else

End If

End Sub

Private Sub cmdpick2_Click()

On Error Resume Next

    Set myNameSpace = myOlApp.GetNamespace("MAPI")

    Set myDestFolder = myNameSpace.PickFolder

    Set myDest2Folder = myDestFolder

    TextBox2.Text = myDestFolder

If Err.Number <> 0 Then

Else

End If

End Sub

Private Sub cmdtest_Click()

Dim myOlApp As New Outlook.Application

Set myNewFolder = myOrig2Folder.CopyTo(myDest2Folder)

Call RemovePST

MsgBox "O ficheiro está em " & TextBox3.Text & "backup.pst o Outlook vai fechar, depois pode fazer backup desse ficheiro"

myOlApp.Quit

End Sub

Sub RemovePST()

    Dim objOL As New Outlook.Application

    Dim objName As Outlook.NameSpace

    Dim objFolder As Outlook.MAPIFolder

    Set objName = objOL.GetNamespace("MAPI")

    Set objFolder = myDest2Folder

    objName.RemoveStore objFolder

End Sub

Sub CreatePST()

    Dim myOlApp As New Outlook.Application

    Dim myNameSpace As Outlook.NameSpace

    Dim pathfdr As String

    Set myNameSpace = myOlApp.GetNamespace("MAPI")

    pathfdr = TextBox3.Text

    myNameSpace.AddStore pathfdr & "\backup.pst"

End Sub

Depois adicionem um módulo com esta informação:

Sub backup_pst()

bckpst.Show vbModeless

End Sub

E sigam as instruções para adicionar esta macro a um botão na barra de ferramentas para facilitar o trabalho.

Como atribuir uma macro a um botão na barra de ferramentas no Outlook

1. Menu View | Toolbars | Customize.
2. No separador Commands, faça clique em Macros no lado esquerdo do ecrã.
3. Arraste a macro (backup_pst) para a barra de ferramentas padrão (por exemplo, para o lado do botão “Send/Receive“).
4. Faça clique com o botão do lado direito do rato e mude o Nome, mude o icone entre outras opções.
5. Faça clique em Close.

Download da aplicação
vba3.zip

Já está à venda em várias livrarias do País

O meu segundo livro: "Domine a 110% o Outlook 2003"
da editora FCA. 

Tudo sobre o livro.

Leia o Press Release

(21-06-2004)