Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 21

Thread: Outlook - count number of emails in Sent Items folder and spit out results in Excel

  1. #1
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location

    Outlook - count number of emails in Sent Items folder and spit out results in Excel

    Hi,

    I am pretty new to VBA and I am working on a VBA script that will allow me to count the number of emails in my sent items folder with an external email address (so basically emails sent out that are not to people within my company).

    I have googled and googled and cannot find anything, is there anyone that can help me.

    Thanks in Advance

  2. #2
    I am not sure where Excel comes into this but the following should point the way. Change your company domain as appropriate. If there are many items in the sent folder this could take a while to run

    Sub CountSent()
    Dim olFolder As Folder
    Dim olItem As Object
    Dim lngCount As Long: lngCount = 0
        Set olFolder = Session.GetDefaultFolder(olFolderSentMail)
        For Each olItem In olFolder.items
            If TypeName(olItem) = "MailItem" Then
                If Not olItem.Recipients(1).Address Like "*@yourcompanydomain.com" Then
                    lngCount = lngCount + 1
                End If
            End If
            DoEvents
        Next olItem
        MsgBox lngCount & " items sent"
    lbl_Exit:
        Set olFolder = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Thank you, I was having trouble trying to read number of items from sent items, so this helps a lot. I really appreciate your help! So my aim is to run a macro that I can run daily that will send me an excel file with 2 columns, Date and Count of emails (from sent items). I actually want it to count emails that have been sent to external email address (so emails not sent to people within my organization). Is this doable?

  4. #4
    The code is essentially the same. You will need a two column worksheet with a header row i.e. Sheet1 of C:\Path\Email Log.xlsx (change the path as required)

    The Date will be column 1. The count will be column 2.

    Change yourdomain.com to your company domain name in order to exclude internal messages.

    Change the date switches "dd/mm/yyyy" to suit local requirements

    The macro counts the messages sent on the current day, so in practice you would run the macro after the last mail of the day in order to correctly record the count.

    The message box is optional.

    Sub CountSent()
    'Graham Mayor - https://www.gmayor.com - Last updated - 24 Sep 2019
    Const strWB As String = "C:\Path\Email Log.xlsx"
    Const strSheet As String = "Sheet1"
    Dim strDate As String
    Dim strValues As String
    Dim olFolder As Folder
    Dim olItem As Object
    Dim lngItem As Long
    Dim lngCount As Long: lngCount = 0
        Set olFolder = Session.GetDefaultFolder(olFolderSentMail)
        For lngItem = olFolder.items.Count To 1 Step -1
            Set olItem = olFolder.items(lngItem)
            If TypeName(olItem) = "MailItem" Then 'count only e-mails
                If CDate(Format(olItem.SentOn, "dd/mm/yyyy")) = CDate(Format(Date, "dd/mm/yyyy")) Then 'test for today's messages
                    If Not olItem.Recipients(1).Address Like "*@yourdomain.com" Then 'ignore internal messages
                        strDate = Format(olItem.SentOn, "dd/mm/yyyy")
                        lngCount = lngCount + 1
                    End If
                Else
                    Exit For
                End If
            End If
            DoEvents
        Next lngItem
        strValues = strDate & "', '" & CStr(lngCount)
        WriteToWorksheet strWorkbook:=strWB, strRange:="Sheet1", strValues:=strValues
    lbl_Exit:
        MsgBox lngCount & " items sent"
        Set olFolder = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    
    
    Private Function WriteToWorksheet(strWorkbook As String, _
                                      strRange As String, _
                                      strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
    lbl_Exit:
        Set CN = Nothing
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Graham, this is perfect thank you so much. This is exactly what I need, however I tested this and it was including an internal email I sent as part of the count. I am wondering if this is the issue...when i click on Outlook Properties of a user, there are more than 1 email addresses showing in the Email Addresses box? I sent myself an email with the other email addresses listed to see if i get those and i do, so i am wondering if that is the issue?
    Last edited by vhrame; 09-24-2019 at 05:30 AM.

  6. #6
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    If that is the case, is there a way to list all the email addresses to exclude?

  7. #7
    The add-in should ignore any e-mail address that looks like *@yourdomain.com" did the e-mail address you sent to have such a domain name?
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  8. #8
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Ok so I found out that my the internal email address is actually something else other than what is shown, so i added that in to exclude and it worked! yay!!

  9. #9
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    I am now working on trying to see if i can update this excel file which has been password protected. I know there is a way to unprotect and protect a file within the VBA code in excel, but I am trying to see if i can do it via Outlook. Graham, thanks for your help :-)

  10. #10
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,577
    Avoid clumsy coding:
    Don't bother with 'protection' in Excel.
    To retrieve yesterday's outmails to external addresses:

    Sub M_uit()
      For Each it In Createobject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items.Restrict("[Senton]>'" & Date - 1 & "' and [Senton]<'" & Date & "'")
         If Right(it.Recipients(1).Address, 10) <> "@mycompany" Then y = y + 1
      Next
    
      sheet1.cells(Rows.Count, 1).End(xlup).offset(1).resize(, 2) = Array(Date - 1, y)
    End Sub
    Have a look also here: http://www.snb-vba.eu/VBA_Outlook_external_en.html#L_5

  11. #11
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Hi Graham, sorry for the delay, I was on vacation. So this is what I was needing, to capture the day before. Where in the coding that you previously provided should I place this? I am still playing around with it and am having trouble.

  12. #12
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Graham, so i used your coding below to grab yesterdays date and i added a "-1" below but it didn't work?

    If CDate(Format(olItem.SentOn, "dd/mm/yyyy")) = CDate(Format(Date-1, "dd/mm/yyyy")) Then 'test for today's messages

  13. #13
    Quote Originally Posted by vhrame View Post
    I am now working on trying to see if i can update this excel file which has been password protected. I know there is a way to unprotect and protect a file within the VBA code in excel, but I am trying to see if i can do it via Outlook. Graham, thanks for your help :-)
    You cannot use ADODB to write to a password protected workbook that isn't open in Excel, so one solution would be to open it e.g. as follows. As it is then open you could write directly to it, but you can still use ADODB as it is likely to be faster. If the workbook isn't already open, the process will open it with the indicated passwords. You will of course need to change those as appropriate.

    Private Function WriteToWorksheet(strWorkbook As String, _                                  strRange As String, _
                                      strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
    Dim xlApp As Object
    Dim xlWB As Object
    Dim vWB As Variant
    Dim bXLStarted As Boolean, bOpen As Boolean
        On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application")
        If Err <> 0 Then
            Set xlApp = CreateObject("Excel.Application")
            bXLStarted = True
        End If
    
    
        vWB = Split(strWorkbook, "\")
        For Each xlWB In xlApp.workbooks
            If xlWB.Name = vWB(UBound(vWB)) Then
                bOpen = True
                Exit For
            End If
        Next xlWB
        If Not bOpen Then
            Set xlWB = xlApp.workbooks.Open(fileName:=strWorkbook, _
                                            Password:="abc123", _
                                            WriteResPassword:="abc123", _
                                            IgnoreReadOnlyRecommended:=True)
        End If
        On Error GoTo 0
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
        If bOpen = False Then
            xlWB.Close 1
        Else
            xlWB.Save
        End If
        If bXLStarted = True Then xlApp.Quit
    lbl_Exit:
        Set CN = Nothing
        Set xlApp = Nothing
        Set xlWB = Nothing
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Thank you Graham! That works!

  15. #15
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Graham, in the below coding, how would I be able to get yesterdays dated emails?

    If CDate(Format(olItem.SentOn, "dd/mm/yyyy")) = CDate(Format(Date, "dd/mm/yyyy")) Then 'test for today's messages

  16. #16
    Change
    CDate(Format(Date, "dd/mm/yyyy"))
    to
    CDate(Format(Date - 1, "dd/mm/yyyy"))
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  17. #17
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    I tried this and it returned a 0 and I do have external emails i sent out yesterday. I was reading online and it mentioned that using FORMAT turns it into a string, so they suggest doing the subtraction first and then doing the format? is that correct?

  18. #18
    Date is a date and Date - 1 is also a date. Format turns the result into a string then CDate turns it back into a date so that it can be compared with Item.SentOn.
    As you live in the States it might be relevant to use a US format date switches in place of "dd/mm/yyyy" so that the regional values don't screw things up.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  19. #19
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    I also tried that and no luck...

  20. #20
    VBAX Regular
    Joined
    Sep 2019
    Posts
    14
    Location
    Graham, I had a work colleague look into this and this is the coding that worked:

    If CDate(Format(olItem.SentOn, "mm/dd/yyyy")) <= CDate(Format(Date - 1, "mm/dd/yyyy")) Then


    If CDate(Format(olItem.SentOn, "mm/dd/yyyy")) = CDate(Format(Date - 1, "mm/dd/yyyy")) Then

    strDate = Format(olItem.SentOn, "mm/dd/yyyy")

    I truly appreciate your help and thank you for everything you have helped me with.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •