Need to set a 'lookback x' days in VB Macro that pulls data from Outlook to Excel-CodePudding

What I am attempting: I am trying to extract emails from a custom subfolder. The emails contain a list of employees that we hire or terminate. The email fires daily. Every month we do an audit in which we have to go through each email and manually copy and paste the userIDs. I created a macro to extract all the emails in the subfolder but I cannot figure out how to filter to look back 45 days versus extract all the emails from the box.

Issue: I am trying to add a filter to look back 45 days only. I don't need the entire box to be extracted just the last 45 days from the day I run the macro. I have googled and couldn't figure it out.



Range("A2:H30000").Clear
Dim OLApp As Outlook.Application
Set OLApp = New Outlook.Application


Dim ONS As Outlook.Namespace

Set ONS = OLApp.GetNamespace("MAPI")
Dim MYFOLDER As Outlook.Folder
 
Set MYFOLDER = ONS.Folders("[email protected]").Folders("Inbox")
Set MYFOLDER = MYFOLDER.Folders("NewHires")

Dim OLMAIL As Outlook.MailItem
Set OLMAIL = OLApp.CreateItem(olMailItem)

Set myItems = MYFOLDER.Items
myItems.Sort "ReceivedTime", True


For Each OLMAIL In myItems
 
Dim oHTML As MSHTML.HTMLDocument
Set oHTML = New MSHTML.HTMLDocument
 
  

Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
.Body.innerHTML = OLMAIL.HTMLBody
Set oElColl = .getElementsByTagName("table")
End With
 
Dim t As Long, r As Long, c As Long
Dim eRow As Long

For t = 0 To oElColl.Length - 1
    eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    For r = 0 To (oElColl(t).Rows.Length - 1)
        For c = 0 To (oElColl(t).Rows(r).Cells.Length - 1)
            Range("A" & eRow).Offset(r, c).Value = oElColl(t).Rows(r).Cells(c).innerText
        Next c
    Next r
    eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    
Next t
 
 
Cells(eRow, 1) = "Sender's Name:" & " " & OLMAIL.Sender
Cells(eRow, 1).Interior.Color = vbRed
Cells(eRow, 1).Font.Color = vbWhite
Cells(eRow, 2) = OLMAIL.ReceivedTime
Cells(eRow, 2).Interior.Color = vbBlue
Cells(eRow, 2).Font.Color = vbWhite
Range(Cells(eRow, 1), Cells(eRow, 2)).Columns.AutoFit
Next OLMAIL


Range("A2").Select

Set OLApp = Nothing
Set OLMAIL = Nothing
Set oHTML = Nothing
Set oElColl = Nothing

ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

End Sub

CodePudding user response：

The method to identify when sent is in the Date property and you can grab the current date when you're running VBA using the Now function.

A method that would seem least intrusive looking at your code would be something like below. This could be shortened but it's more detailed to explain how to get the key things you're looking for.

For Each OLMAIL In myItems
  ''New code
  Dim daysBack as Date, dateOfEmail as Date
  daysBack = vba.Now - 45
  dateOfEmail = OLMAIL.Date
  If dateOfEmail < daysBack then Exit For
  ''end of new code

CodePudding user response：

Instead of iterating over all items in the folder:

For Each OLMAIL In myItems

You need to use the Find/FindNext or Restrict methods of the Items class instead. In that case you will iterate over the items that correspond to your search criteria. Read more about these methods in the following articles:

For example, you could use logical AND operator to combine two conditions together:


    Dim datStartUTC As Date 
    Dim datEndUTC As Date 

    datStartUTC = oPA.LocalTimeToUTC(Date) 
    datEndUTC = oPA.LocalTimeToUTC(DateAdd("d", 45, Date)) 

    'This filter uses urn:schemas:httpmail namespace 
    strFilter = AddQuotes("urn:schemas:httpmail:datereceived") _ 
    & " > '" & datStartUTC & "' AND " _ 
    & AddQuotes("urn:schemas:httpmail:datereceived") _ 
    & " < '" & datEndUTC & "'"

And here is the auxiliary function used in the sample code above:

Public Function AddQuotes(ByVal SchemaName As String) As String 
    On Error Resume Next 
    AddQuotes = Chr(34) & SchemaName & Chr(34) 
End Function

To make sure that the date-time comparison string is formatted as Microsoft Outlook expects, use the Visual Basic for Applications Format function (or its equivalent in your programming language).