L
lberendsen
Hello,
I need to collect some tasks in a task folder to build a status e-mail.
Acctualy, I did it very well, but the sort classification are ignored.
How can i collect the tasks respecting the sort order?
Thank's in advance.
-
Here is the code:
Const C_ROOTITEM = 1
Dim oRoot As Outlook.Folder
Dim oFila As Outlook.Folder
Dim oEquipe As Outlook.Folder
Dim colInProgress As New Collection
Dim colWaiting As New Collection
Dim colNotStarted As New Collection
Dim oTask As taskItem
Dim oContact As ContactItem
Dim colDestinatários As New Collection
Dim colEmCópia As New Collection
Dim oNovoMail As MailItem
Dim strTo As String
Dim strCC As String
Dim strCorpo As String
Public Sub ReportAll()
' collect tasks and recipients
Set colInProgress = GetTasksByStatus(olTaskInProgress)
Set colNotStarted = GetTasksByStatus(olTaskNotStarted)
Set colWaiting = GetTasksByStatus(olTaskWaiting)
Set colDestinatários = GetRecipientsByJobTitle("LÃder")
Set colEmCópia = GetRecipientsByJobTitle("Gerente")
' build a new e-mail
Set oNovoMail = Application.CreateItem(olMailItem)
oNovoMail.To = BuildRecipientList(colDestinatários)
oNovoMail.CC = BuildRecipientList(colEmCópia)
oNovoMail.Subject = "Fila de Validações"
'@@
'@@ e-mail body
'@@
strCorpo = ""
' Introdução
strCorpo = "Pessoal,"
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Segue a fila da validações"
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Caso tenham alguma urgência, comuniquem-me
imediatamente que eu repriorizo na hora"
strCorpo = strCorpo + Chr(13)
' to-do itens
If colNotStarted.Count > 0 Then
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "A REVISAR"
strCorpo = strCorpo + Chr(13) + Chr(13)
For Each oTask In colNotStarted
strCorpo = strCorpo + oTask.Subject & " (" & oTask.ContactNames
& ")" & Chr(13)
Next
End If
' on going itens
If colInProgress.Count > 0 Then
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "EM REVISÃO"
strCorpo = strCorpo + Chr(13) + Chr(13)
For Each oTask In colInProgress
strCorpo = strCorpo + VerboseTask(oTask) & Chr(13)
Next
End If
' waiting itens
If colWaiting.Count > 0 Then
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "AGUARDANDO RETORNO"
strCorpo = strCorpo + Chr(13) + Chr(13)
For Each oTask In colWaiting
strCorpo = strCorpo + VerboseTask(oTask) & Chr(13)
Next
End If
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Obrigado,"
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Lorenzo"
oNovoMail.Body = strCorpo
'@@
'@@ show the e-mail to send
'@@
oNovoMail.Recipients.ResolveAll
oNovoMail.Display
End Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' TOOLS FUNCTIONS
'
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Sub GotoFilaNatura()
' Abre a fila Natura
Dim oFila As Outlook.Folder
Call SetRoot
Set oFila = GetFolder("FilaNatura", oRoot)
oFila.Display
End Sub
Public Sub SetRoot()
' Retorna a raiz da pasta local.
' Esta função garante que a aplicação trabalhe sempre com uma pasta especÃfica
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oTempRoot As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oTempRoot = oStore.GetRootFolder
If oTempRoot.Name = "Personal Folders" Then
Set oRoot = oTempRoot
End If
Next
End Sub
Public Function GetFolder(ByVal folderName As String, oBase As
Outlook.Folder) As Outlook.Folder
' Passando um nome, retorna um ponteiro para o folder com o mesmo nome
' Em qualquer nÃvel de profundidade.
Dim folders As Outlook.folders
Dim Folder As Outlook.Folder
Dim foldercount As Integer
On Error Resume Next
Set folders = oBase.folders
foldercount = folders.Count
'Check if there are any folders below oFolder
If foldercount Then
For Each Folder In folders
If Folder.Name = folderName Then
Set GetFolder = Folder
Else
GetFolder folderName, Folder
End If
Next
End If
End Function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' QUERY FUNCTIONS
'
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Function GetTasksByStatus(ByVal targetStatus As Variant) As Collection
' Retorna todos os itens da fila que tenham um stats especÃfico
Dim colNewCollection As New Collection
Dim taskIndex As taskItem
' Obtém os repositórios
Call SetRoot
Set oFila = GetFolder("FilaNatura", oRoot)
Set colNewCollection = Nothing
For Each taskIndex In oFila.Items
If taskIndex.Status = targetStatus Then
colNewCollection.Add taskIndex
End If
Next
Set GetTasksByStatus = colNewCollection
End Function
Public Function GetRecipientsByJobTitle(ByVal targetRole As Variant) As
Collection
' Retorna todos as pessoas que tenham um job title especÃfico
Dim colNewCollection As New Collection
Dim contactIndex As ContactItem
' Obtém os repositórios
Call SetRoot
Set oEquipe = GetFolder("EquipeNatura", oRoot)
Set colNewCollection = Nothing
For Each contactIndex In oEquipe.Items
If contactIndex.JobTitle = targetRole Then
colNewCollection.Add contactIndex
End If
Next
Set GetRecipientsByJobTitle = colNewCollection
End Function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' TRANSFORMATION FUNCTIONS
'
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Function BuildRecipientList(colRecipientsList As Collection) As String
' Coloca uma lista de pessoas em uma string separada por ponto-e-vÃrgula
Dim strTo As String
Dim contactIndex As ContactItem
strTo = ""
For Each contactIndex In colRecipientsList
strTo = strTo + contactIndex.Email1DisplayName
strTo = strTo + " ; "
Next
BuildRecipientList = strTo
End Function
Public Function VerboseTask(aTask As taskItem) As String
' Representa uma task em uma string
Dim strResponsável As String
Dim strNome As String
strNome = aTask.Subject
strResponsável = aTask.ContactNames
VerboseTask = strNome & " (" & strResponsável & ")"
End Function
I need to collect some tasks in a task folder to build a status e-mail.
Acctualy, I did it very well, but the sort classification are ignored.
How can i collect the tasks respecting the sort order?
Thank's in advance.
-
Here is the code:
Const C_ROOTITEM = 1
Dim oRoot As Outlook.Folder
Dim oFila As Outlook.Folder
Dim oEquipe As Outlook.Folder
Dim colInProgress As New Collection
Dim colWaiting As New Collection
Dim colNotStarted As New Collection
Dim oTask As taskItem
Dim oContact As ContactItem
Dim colDestinatários As New Collection
Dim colEmCópia As New Collection
Dim oNovoMail As MailItem
Dim strTo As String
Dim strCC As String
Dim strCorpo As String
Public Sub ReportAll()
' collect tasks and recipients
Set colInProgress = GetTasksByStatus(olTaskInProgress)
Set colNotStarted = GetTasksByStatus(olTaskNotStarted)
Set colWaiting = GetTasksByStatus(olTaskWaiting)
Set colDestinatários = GetRecipientsByJobTitle("LÃder")
Set colEmCópia = GetRecipientsByJobTitle("Gerente")
' build a new e-mail
Set oNovoMail = Application.CreateItem(olMailItem)
oNovoMail.To = BuildRecipientList(colDestinatários)
oNovoMail.CC = BuildRecipientList(colEmCópia)
oNovoMail.Subject = "Fila de Validações"
'@@
'@@ e-mail body
'@@
strCorpo = ""
' Introdução
strCorpo = "Pessoal,"
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Segue a fila da validações"
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Caso tenham alguma urgência, comuniquem-me
imediatamente que eu repriorizo na hora"
strCorpo = strCorpo + Chr(13)
' to-do itens
If colNotStarted.Count > 0 Then
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "A REVISAR"
strCorpo = strCorpo + Chr(13) + Chr(13)
For Each oTask In colNotStarted
strCorpo = strCorpo + oTask.Subject & " (" & oTask.ContactNames
& ")" & Chr(13)
Next
End If
' on going itens
If colInProgress.Count > 0 Then
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "EM REVISÃO"
strCorpo = strCorpo + Chr(13) + Chr(13)
For Each oTask In colInProgress
strCorpo = strCorpo + VerboseTask(oTask) & Chr(13)
Next
End If
' waiting itens
If colWaiting.Count > 0 Then
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "AGUARDANDO RETORNO"
strCorpo = strCorpo + Chr(13) + Chr(13)
For Each oTask In colWaiting
strCorpo = strCorpo + VerboseTask(oTask) & Chr(13)
Next
End If
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Obrigado,"
strCorpo = strCorpo + Chr(13)
strCorpo = strCorpo + "Lorenzo"
oNovoMail.Body = strCorpo
'@@
'@@ show the e-mail to send
'@@
oNovoMail.Recipients.ResolveAll
oNovoMail.Display
End Sub
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' TOOLS FUNCTIONS
'
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Sub GotoFilaNatura()
' Abre a fila Natura
Dim oFila As Outlook.Folder
Call SetRoot
Set oFila = GetFolder("FilaNatura", oRoot)
oFila.Display
End Sub
Public Sub SetRoot()
' Retorna a raiz da pasta local.
' Esta função garante que a aplicação trabalhe sempre com uma pasta especÃfica
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oTempRoot As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oTempRoot = oStore.GetRootFolder
If oTempRoot.Name = "Personal Folders" Then
Set oRoot = oTempRoot
End If
Next
End Sub
Public Function GetFolder(ByVal folderName As String, oBase As
Outlook.Folder) As Outlook.Folder
' Passando um nome, retorna um ponteiro para o folder com o mesmo nome
' Em qualquer nÃvel de profundidade.
Dim folders As Outlook.folders
Dim Folder As Outlook.Folder
Dim foldercount As Integer
On Error Resume Next
Set folders = oBase.folders
foldercount = folders.Count
'Check if there are any folders below oFolder
If foldercount Then
For Each Folder In folders
If Folder.Name = folderName Then
Set GetFolder = Folder
Else
GetFolder folderName, Folder
End If
Next
End If
End Function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' QUERY FUNCTIONS
'
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Function GetTasksByStatus(ByVal targetStatus As Variant) As Collection
' Retorna todos os itens da fila que tenham um stats especÃfico
Dim colNewCollection As New Collection
Dim taskIndex As taskItem
' Obtém os repositórios
Call SetRoot
Set oFila = GetFolder("FilaNatura", oRoot)
Set colNewCollection = Nothing
For Each taskIndex In oFila.Items
If taskIndex.Status = targetStatus Then
colNewCollection.Add taskIndex
End If
Next
Set GetTasksByStatus = colNewCollection
End Function
Public Function GetRecipientsByJobTitle(ByVal targetRole As Variant) As
Collection
' Retorna todos as pessoas que tenham um job title especÃfico
Dim colNewCollection As New Collection
Dim contactIndex As ContactItem
' Obtém os repositórios
Call SetRoot
Set oEquipe = GetFolder("EquipeNatura", oRoot)
Set colNewCollection = Nothing
For Each contactIndex In oEquipe.Items
If contactIndex.JobTitle = targetRole Then
colNewCollection.Add contactIndex
End If
Next
Set GetRecipientsByJobTitle = colNewCollection
End Function
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' TRANSFORMATION FUNCTIONS
'
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Function BuildRecipientList(colRecipientsList As Collection) As String
' Coloca uma lista de pessoas em uma string separada por ponto-e-vÃrgula
Dim strTo As String
Dim contactIndex As ContactItem
strTo = ""
For Each contactIndex In colRecipientsList
strTo = strTo + contactIndex.Email1DisplayName
strTo = strTo + " ; "
Next
BuildRecipientList = strTo
End Function
Public Function VerboseTask(aTask As taskItem) As String
' Representa uma task em uma string
Dim strResponsável As String
Dim strNome As String
strNome = aTask.Subject
strResponsável = aTask.ContactNames
VerboseTask = strNome & " (" & strResponsável & ")"
End Function