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