Imagine que quer receber uma
notificação sempre que uma nova mensagem é colocada numa Pasta
Pública (Public Folder).
Para isso siga estas instruções:
Neste exemplo vou utilizar a aplicação de Help Desk da Microsoft
e a hierarquia de pastas são:
Public Folder
All Public Folders
PT
Help Desk Request
PTHelp
Sempre que uma nova mensagem surge na pasta PTHelp surge esta
caixa de diálogo ou pop-up (que terá que criar – no entanto pode
seguir o modelo do ficheiro anexo), depois se estou a visualizar
mensagens na pasta A Receber posso rapidamente aceder à Pasta
Pública fazendo clique no botão Link (em vez de percorrer toda a
hierarquia de pastas).
O código está dividido em duas
partes:
O código para a caixa de diálogo –
activado cada vez que chega uma nova mensagem à Pasta Pública
definida.
O código para abrir a Pasta Pública – que abre a Pasta Pública
definida independentemente da posição onde se encontra.
Excepção: Este aviso só funciona
quando o Outlook está aberto, ou seja, se o Outlook estiver
fechado não funciona. Isto implica que sempre que ligar o
computador de manhã tem de verificar se durante o tempo que
esteve ausente houve novas mensagens.
Código para caixa de diálogo
(pop-up)
ThisOutlookSession
Private WithEvents olHDRItems As
Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olHDRItems = objNS.Folders("Public Folders").Folders("All
Public Folders").Folders("PT").Folders("Help Desk
Application").Folders("PTHelp").Items
Set objNS = Nothing
End Sub
Private Sub Application_Quit()
Set olHDRItems = Nothing
End Sub
Private Sub
olHDRItems_ItemAdd(ByVal Item As Object)
Dim objHDR As MAPIFolder
Dim objNS As NameSpace
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objHDR = objNS.Folders("Public Folders").Folders("All Public
Folders").Folders("PT").Folders("Help Desk
Application").Folders("PTHelp").Items
If Item.Class = olMail Then
frmnovoAHT.Show vbModeless
With frmnovoAHT
.lblrec.Caption = Now
.Repaint
End With
End If
On Error GoTo 0
Set objHDR = Nothing
Set objNS = Nothing
End Sub
Código para o botão Link
frmnovoAHT
Private Sub cmdLink_Click()
Dim myExplorer As Object
Dim myNameSpace As Outlook.NameSpace
Dim myFolder, myFolder1, myFolder2, myFolder3, myFolder4 As
Outlook.MAPIFolder
Dim myFolders As Outlook.Folders
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders("Public Folders").Folders
For Each myFolder In myFolders
If myFolder.name = "All Public Folders" Then
For Each myFolder1 In myFolder.Folders
If myFolder1.name = "PT" Then
For Each myFolder2 In
myFolder1.Folders
If
myFolder2.name = "Help Desk Application" Then
For Each myFolder3 In myFolder2.Folders
If myFolder3.name = "PTHelp" Then
frmnovoAHT.Hide
Set myExplorer = myFolder3.GetExplorer
myExplorer.Activate
Call myFolder3.Display
Exit Sub
End If
Next
End If
Next
End If
Next
End If
Next
End Sub |
