Este código VBA pode ser usado em Outlook2003/7 para contar o número de mensagens enviadas ontem (ou noutro dia)
Public iCount
Private Sub Count_Yesterday()
Dim oNS As NameSpace
Dim oFolder As MAPIFolder
Dim strBody As String
Dim objMsg As MailItem
Dim intCount As Integer
Dim i As Integer
Dim iMeetCount As Integer
Dim dtPrevDate As Date
Dim blnDateChanged As Boolean
SentcomSub1 = 0
InboxcomSub1 = 0
SentcomSub2 = 0
InboxcomSub2 = 0
iCount = 0
Set oNS = GetNamespace(“MAPI”)
Set oFolder = oNS.GetDefaultFolder(olFolderSentMail)
intCount = oFolder.Items.Count
Set objMsg = Application.CreateItem(olMailItem)
iMeetCount = 0
antes = InputBox(“Quer contar quantos dias para atras? Se responder em branco, assume 1 dia (ontem)”)
If antes = “” Then antes = 1
dtPrevDate = Date – antes
For i = 1 To intCount
Select Case oFolder.Items(i).Class
Case olAppointment
‘Don’t do anything at this time, might need this functionality later
Case olContact
‘Don’t do anything at this time, might need this functionality later
Case olMail
‘Set myOlApp = CreateObject(“Outlook.Application”)
‘Set myItem = myOlApp.ActiveInspector.CurrentItem
‘mfrom = myItem.SenderName
If dtPrevDate = DateValue(oFolder.Items(i).CreationTime) And InStr(oFolder.Items(i).Recipients(1), “on behalf of; ASASASAS“) > 0 Then
‘strBody = strBody & “Creation Time: ” & oFolder.Items(i).CreationTime & vbCrLf
‘strBody = strBody & “Subject: ” & oFolder.Items(i).Subject & vbCrLf
‘strBody = strBody & “To: ” & oFolder.Items(i).Recipients(1) & vbCrLf & vbCrLf
‘Print #1, “From: ” & MailItem.SentOnBehalfOfName
iCount = iCount + 1
sub1 = “Nome de template“
If oFolder.Items(i).Subject = sub1 Then
SentcomSub1 = SentcomSub1 + 1
End If
‘sub2 = “RE: Publisher”
‘If oFolder.Items(i).Subject = sub2 Then
‘ SentcomSub2 = SentcomSub2 + 1
‘End If
End If
Case olMeetingRequest
‘Don’t do anything at this time, might need this functionality later
End Select
Next
iSent = iCount
iCount = 0
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
intCount = oFolder.Items.Count
Set objMsg = Application.CreateItem(olMailItem)
iMeetCount = 0
‘dtPrevDate = Date – 1
For i = 1 To intCount
Select Case oFolder.Items(i).Class
Case olAppointment
‘Don’t do anything at this time, might need this functionality later
Case olContact
‘Don’t do anything at this time, might need this functionality later
Case olMail
‘MsgBox DateValue(oFolder.Items(i).CreationTime)
If dtPrevDate = DateValue(oFolder.Items(i).CreationTime) Then
‘strBody = strBody & “Creation Time: ” & oFolder.Items(i).CreationTime & vbCrLf
‘strBody = strBody & “Subject: ” & oFolder.Items(i).Subject & vbCrLf
‘strBody = strBody & “To: ” & oFolder.Items(i).Recipients(1) & vbCrLf & vbCrLf
iCount = iCount + 1
If oFolder.Items(i).Subject = “Nome de template” Then
InboxcomSub1 = InboxcomSub1 + 1
End If
‘RE: Publisher
‘If oFolder.Items(i).Subject = “RE: Publisher” Then
‘ InboxcomSub2 = InboxcomSub2 + 1
‘End If
End If
Case olMeetingRequest
‘Don’t do anything at this time, might need this functionality later
End Select
Next
iInbox = iCount
objMsg.To = “nome@mail.pt”
objMsg.Subject = “Contagens das mensagens de mail enviadas ontem: ” & CStr(dtPrevDate)
objMsg.Body = “Foram enviadas (Sent Items) com <on behalf of; ASASASAAS>: ” & CStr(iSent) & ” mensagens desta mailbox.” & Chr(13) & “Foram recebidas (Inbox): ” & CStr(iInbox) & ” mensagens desta mailbox.” & Chr(13) & Chr(13) & “Mensagens com um Subject especfico (exato):” & Chr(13) & _
” Com Sent Items:Subject: <” & sub1 & “> -> ” & CStr(SentcomSub1) & Chr(13) & ” Com Inbox:Subject: ” & sub1 & ” -> ” & CStr(InboxcomSub1) & Chr(13)
‘” Com Sent Items:Subject: ” & sub2 & ” -> ” & CStr(SentcomSub2) & Chr(13) & ” Com Inbox:Subject: ” & sub2 & ” -> ” & CStr(InboxcomSub2) & Chr(13)
objMsg.Send
Set oNS = Nothing
Set oFolder = Nothing
Set oNewMail = Nothing
Set objMsg = Nothing
End Sub
Sendo um “frakenstein” de vário código disperso na Net, com muitas partes comentadas (funcionais) para fácil expansão de capacidades.
Comentários Recentes