Count emails in last 7 days

[hmltnangel]

Ok, been using a quick bit of VBA with some help from folks on here to count emails from individuals.

It works great but I'm now needing to amend it a tiny bit to only count things in the last 7 days.

Keep getting error messages with this -

Sub CountItems1()
 
Dim pos() As Integer, cnt() As Integer
listofnames = Array("Dave", "Fred", "Jim", "Alan", "Claire") ' get array of names from whereever
ReDim pos(UBound(listofnames))
ReDim cnt(UBound(listofnames))
Set folderitems = ActiveExplorer.CurrentFolder.Items ' change folder to suit, if it not the active one
For Each mitem In folderitems
    If DateDiff("d", msg.SentOn, Now) <= 7 Then
    strt = Len(mitem.Body)
    For i = 0 To UBound(pos)
        pos(i) = InStrRev(mitem.Body, listofnames(i), strt)
        If pos(i) > 0 Then strt = pos(i): firstfnd = listofnames(i)
    Next
    For i = 0 To UBound(listofnames)
        If listofnames(i) = firstfnd Then cnt(i) = cnt(i) + 1: Exit For
    Next
     
For i = 0 To UBound(listofnames)
    msg = msg & listofnames(i) & " count of emails = " & cnt(i) & vbNewLine
Next
MsgBox msg 'for testing only, you could  add each to an array for later processing
 
End Sub

It highlights my last End Sub ..... and says Block If Without End If.

Anyone any ideas

[Bob Phillips]

Maybe

Sub CountItems1()
 
Dim pos() As Integer, cnt() As Integer
listofnames = Array("Dave", "Fred", "Jim", "Alan", "Claire") ' get array of names from whereever
ReDim pos(UBound(listofnames))
ReDim cnt(UBound(listofnames))
Set folderitems = ActiveExplorer.CurrentFolder.Items ' change folder to suit, if it not the active one
For Each mitem In folderitems
    If DateDiff("d", msg.SentOn, Now) <= 7 Then
    strt = Len(mitem.Body)
    For i = 0 To UBound(pos)
        pos(i) = InStrRev(mitem.Body, listofnames(i), strt)
        If pos(i) > 0 Then strt = pos(i): firstfnd = listofnames(i)
    Next i
    For i = 0 To UBound(listofnames)
        If listofnames(i) = firstfnd Then cnt(i) = cnt(i) + 1: Exit For
    Next i
    End If
Next mitem
 
For i = 0 To UBound(listofnames)
    msg = msg & listofnames(i) & " count of emails = " & cnt(i) & vbNewLine
Next i
MsgBox msg 'for testing only, you could  add each to an array for later processing
 
End Sub

[hmltnangel]

Thanks - needed to make a quick adjustment to it but works fine now Your little bit of help solved the problem.

Sub CountItems1()
     
    Dim pos() As Integer, cnt() As Integer
    listofnames = Array("Dave", "Fred", "Jim", "Alan", "Wendy") ' get array of names from whereever
    ReDim pos(UBound(listofnames))
    ReDim cnt(UBound(listofnames))
    Set folderitems = ActiveExplorer.CurrentFolder.Items ' change folder to suit, if it not the active one
    For Each mitem In folderitems
        Set msgs = mitem
        If DateDiff("d", msgs.SentOn, Now) <= 7 Then
            strt = Len(mitem.Body)
            For i = 0 To UBound(pos)
                pos(i) = InStrRev(mitem.Body, listofnames(i), strt)
                If pos(i) > 0 Then strt = pos(i): firstfnd = listofnames(i)
            Next i
            For i = 0 To UBound(listofnames)
                If listofnames(i) = firstfnd Then cnt(i) = cnt(i) + 1: Exit For
            Next i
        End If
    Next mitem
     
    For i = 0 To UBound(listofnames)
        msg = msg & listofnames(i) & " count of emails = " & cnt(i) & vbNewLine
    Next i
    MsgBox msg 'for testing only, you could  add each to an array for later processing
     
End Sub

[Bob Phillips]

Why a new variable, why not just use

        If DateDiff("d", mitem.SentOn, Now) <= 7 Then