Excel Macro Adds Additional Incorrect Information In Email Data Sheet

[Si1209]

Sub NWHFX1()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNameSpace("MAPI")
Application.ScreenUpdating = False
                                     
   On Error Resume Next
   Set objFolder = objnSpace.Folders("Mailbox - $north west halifax").Folders("Inbox")
   If Err.Number <> 0 Then
   Err.Clear
   ''MsgBox "No such folder."
   Exit Sub
   End If
   
 Dim iCount As Integer, DateCount As Integer
 Dim myDate As Date
 EmailCount = objFolder.Items.Count
 DateCount = 0
 myDate = Sheets("Sheet1").Range("h9").Value
   
 If EmailCount > 0 Then
 For iCount = 1 To EmailCount
 With objFolder.Items(iCount)
 If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) = myDate Then DateCount = DateCount + 1
 End With
 Next iCount
 End If

 Cells(10, 8).Value = DateCount
'MsgBox "Number of emails in MIS folder with matching date: " & DateCount, , "MIS date count"
 'On Error Resume Next
  ' Set objFolder = objnSpace.Folders("Mailbox - $north west halifax").Folders("Inbox")
   ''If Err.Number <> 0 Then
   'Err.Clear
   '''MsgBox "No such folder."
   'Exit Sub
   'End If
 
 DateCount = 0
 myDate = Sheets("Sheet1").Range("g9").Value
   
 If EmailCount > 0 Then
 For iCount = 1 To EmailCount
 With objFolder.Items(iCount)
 If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) = myDate Then DateCount = DateCount + 1
 End With
 Next iCount
 End If
 
 Set objFolder = Nothing
 Set objnSpace = Nothing
 Set objOutlook = Nothing
 
 Cells(10, 7).Value = DateCount
   
  

End Sub
Sub NWHFX2()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNameSpace("MAPI")
                                     
   On Error Resume Next
   Set objFolder = objnSpace.Folders("Mailbox - $north west halifax").Folders("Inbox")
   If Err.Number <> 0 Then
   Err.Clear
   ''MsgBox "No such folder."
   Exit Sub
   End If
   
   ' Today - 3 Count in NW HFX''''''''''''''''''
   
 Dim iCount As Integer, DateCount As Integer
 Dim myDate As Date
 EmailCount = objFolder.Items.Count
 DateCount = 0
 myDate = Sheets("Sheet1").Range("f9").Value
   
 If EmailCount > 0 Then
 For iCount = 1 To EmailCount
 With objFolder.Items(iCount)
 If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) = myDate Then DateCount = DateCount + 1
 End With
 Next iCount
 End If

 Cells(10, 6).Value = DateCount
 
 ' Today - 4 Count in NW HFX'''''''''''''''''
 
 DateCount = 0
 myDate = Sheets("Sheet1").Range("e9").Value
   
 If EmailCount > 0 Then
 For iCount = 1 To EmailCount
 With objFolder.Items(iCount)
 If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) = myDate Then DateCount = DateCount + 1
 End With
 Next iCount
 End If

 Cells(10, 5).Value = DateCount
 
 ' Today - 5 Count NW HFX'''''''''''''''''
 
  DateCount = 0
 myDate = Sheets("Sheet1").Range("d9").Value
   
 If EmailCount > 0 Then
 For iCount = 1 To EmailCount
 With objFolder.Items(iCount)
 If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) = myDate Then DateCount = DateCount + 1
 End With
 Next iCount
 End If
 
 Cells(10, 4).Value = DateCount




End Sub

So theres this email spreadsheet, the code above goes in to outlook and counts emails from that mailbox on the dates called and then imports them in to the spreadsheet in excel.

However one problem that keeps cropping up is that the macro for some reason counts extra information that isnt there. So for example we know that on the 15th September we have no emails left in the mailbox, however when we run the macro the results come back with 1 email outstanding for that date.

This is, as mentioned, incorrect so it should be showing 0. It tends to add on 1 or 3 emails normally when the actual number should be 0 but it does tend to add on 1 to dates where we may have 1 email outstanding.

Any help would be fantastic

 

[baitmaster]

Haven't got all the way through yet, but it strikes me that you have an uncleared error handler right near the start. You need an [On Error Goto 0] line to stop it missing other issues, it's the sort of thing that might cause this

 

[Si1209]

Hey thanks for that, saw something similar on another board i posted the query. However a few changes to the code and now its just returning 0's in the whole form not sure why or how but this is the code with a few recommended changes, wondered if anyone could spot why its now reutrning 0's for every mailbox and for every day.

Sub NWHFX1()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNameSpace("MAPI")
Application.ScreenUpdating = False
                                     
   On Error Resume Next
   Set objFolder = objnSpace.Folders("Mailbox - $north west halifax").Folders("Inbox")
   If Err.Number <> 0 Then
   Err.Clear
   ''MsgBox "No such folder."
   Exit Sub
   End If
   On Error GoTo 0
   
 Dim iCount As Integer, DateCount As Integer
 Dim myDate As Date
 EmailCount = objFolder.Items.Count
 DateCount = 0
 myDate = Sheets("Sheet1").Range("h9").Value
   
If EmailCount > 0 Then
    For iCount = 1 To EmailCount
        With objFolder.Items(iCount)
            If .Class = olMail Then
                 ' Items may not be mailitems
                 ' If those items do not have a ReceivedTime property
                 '  they will still be counted
                 '  due to the On Error Resume Next
                If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) = myDate Then
                    DateCount = DateCount + 1
                End If
            Else
                Debug.Print .Subject
                 
            End If
        End With
    Next iCount
End If

 

[baitmaster]

what do you mean "returning"? I don't see anywhere that anything is returned. E.g. you're incrementing dateCount but not doing anything with it