Note: The other languages of the website are Google-translated. Back to English

Como contar o número de emails enviados por mês no Outlook?

Às vezes, você pode querer saber quantos e-mails você enviou por mês. Este tutorial apresentará um código VBA para você contar o número de emails enviados por mês no Outlook.


Conte o número de emails enviados por mês no Outlook com código VBA

Aplique o código VBA abaixo para obter o número de e-mails enviados a cada mês, conforme mostrado abaixo:

1. Segure o ALT + F11 chaves para abrir o Microsoft Visual Basic para Aplicações janela.

2. Clique inserção > Móduloe cole o seguinte código no Módulo Janela.

Código VBA: Conte o número de emails enviados por mês:

Dim GDictionary As Object
Sub CountSentMailsByMonth()
'Updateby Extendoffice
Dim xSentFolder As Outlook.Folder
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xMonths As Variant
Dim xItemsCount As Variant
Dim xLastRow As Integer
Dim I As Integer
Dim xAccount As Account
On Error Resume Next
Set GDictionary = CreateObject("Scripting.Dictionary")
For Each xAccount In Application.Session.Accounts
  If VBA.LCase$(xAccount.SmtpAddress) = VBA.LCase$("yy@addin99.com") Then  'Specify the Email Account
    Set xSentFolder = xAccount.DeliveryStore.GetDefaultFolder(olFolderSentMail)
    If xSentFolder.DefaultItemType = olMailItem Then
      Call ProcessFolders(xSentFolder)
    End If
  End If
Next
Set xSentFolder = Nothing
Set xExcelApp = CreateObject("Excel.Application")
xExcelApp.Visible = True
Set xWb = xExcelApp.Workbooks.Add
Set xWs = xWb.Sheets(1)
With xWs
  .Cells(1, 1) = "Month"
  .Cells(1, 2) = "Count"
  .Cells(1, 1).Font.Bold = True
  .Cells(1, 2).Font.Bold = True
  .Cells(1, 1).HorizontalAlignment = xlCenter
  .Cells(1, 2).VerticalAlignment = xlCenter
End With
xMonths = GDictionary.Keys
xItemsCount = GDictionary.Items
For I = LBound(xMonths) To UBound(xMonths)
  xLastRow = xWs.Range("A" & xWs.Rows.Count).End(xlUp).Row + 1
  With xWs
    .Cells(xLastRow, 1) = xMonths(I)
    .Cells(xLastRow, 2) = xItemsCount(I)
  End With
Next
xWs.Columns("A:B").AutoFit
xExcelApp.Visible = True
Set xExcelApp = Nothing
Set xWb = Nothing
Set xWs = Nothing
End Sub

Sub ProcessFolders(ByVal Fld As Outlook.Folder)
Dim I As Long
Dim xMail As Outlook.MailItem
Dim xMonth As String
Dim xSubFolder As Folder
On Error Resume Next
For I = Fld.Items.Count To 1 Step -1
  If Fld.Items(I).Class = olMail Then
    Set xMail = Fld.Items(I)
    xMonth = Year(xMail.SentOn) & "/" & Month(xMail.SentOn)
    If GDictionary.Exists(xMonth) Then
      GDictionary(xMonth) = GDictionary(xMonth) + 1
    Else
      GDictionary.Add xMonth, 1
    End If
  End If
Next
If Fld.Folders.Count > 0 Then
  For Each xSubFolder In Fld.Folders
    Call ProcessFolders(xSubFolder)
  Next
End If
End Sub
Nota: No código, altere a conta de e-mail “aa@addin99.com” para o seu.

3. Ainda no Microsoft Visual Basic para Aplicações janela, clique em Ferramentas > Referências, Na Referências-Projeto caixa de diálogo, verifique Biblioteca de objetos do Microsoft Excel 16.0 opção do Referências Disponíveis caixa de lista, veja a captura de tela:

4. Então clique OK para fechar a caixa de diálogo e pressione F5 chave para executar este código. Em seguida, será aberto um arquivo do Excel, que exibe as contagens de e-mails enviados de cada mês para a conta específica, veja a captura de tela:


Kutools for Outlook - traz 100 recursos avançados para o Outlook e torna o trabalho muito mais fácil!

  • Auto CC / BCC por regras ao enviar e-mail; Avanço automático Vários emails por encomenda; Resposta automatica sem servidor Exchange e mais recursos automáticos ...
  • Aviso BCC - mostrar mensagem quando você tentar responder a todos se o seu endereço de e-mail estiver na lista BCC; Lembrar quando houver anexos ausentes, e mais recursos de lembrete ...
  • Responder (todos) com todos os anexos na conversa de correio; Responder muitos e-mails em segundos; Adicionar saudação automaticamente quando responder; Adicionar data ao assunto ...
  • Ferramentas de anexo: gerenciar todos os anexos em todos os e-mails, Desanexação Automática, Comprimir tudo, Renomear tudo, Salvar tudo ... Relatório rápido, Contar e-mails selecionados...
  • Lixo eletrônico poderoso por costume; Remover e-mails e contatos duplicados... Permite que você faça de maneira mais inteligente, rápida e melhor no Outlook.
tiro kutools aba kutools do outlook 1180x121
tiro kutools outlook kutools mais guia 1180x121
 
Comentários (0)
Ainda não há classificações. Seja o primeiro a avaliar!
Não há comentários postados aqui ainda
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos

Siga-nos

Copyright © 2009 - www.extendoffice.com. | Todos os direitos reservados. Distribuído por ExtendOffice. | | | Mapa do site
Microsoft e o logotipo do Office são marcas comerciais ou marcas registradas da Microsoft Corporation nos Estados Unidos e / ou em outros países.
Protegido por Sectigo SSL