Loop through subfolders by name - vba

Question

The folder path is "Mailbox - IT Support Center"\"Onshore - Josh"\"Completed".
I want to know the total number of emails in each person's completed mailbox from yesterday.
There are about 25 mailboxes but they all follow the same path starting at Mailbox - IT Support Center.
The script works except for the loop. It iterates through to the second folder but it still searches the first mailbox. Most likely something wrong with objfolder.
Sub CompletedEmailCount()
Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim MailItem
Dim EmailCount As Integer
Dim strFolderName
Dim FolderName() As Variant
Dim i As Integer
Dim objFolder1
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.GetDefaultFolder(olFolderInbox)
strFolderName = ("Mailbox - IT Support Center")
ReDim FolderName(3) 'change this to how many folders you have
'assign each folder name on the array elements
FolderName(1) = ("Onshore - Josh")
FolderName(2) = ("OnShore - Ashton")
FolderName(3) = ("OnShore - Beth")
'loop through each foldername
For i = 1 To 3
On Error Resume
Next
Set objFolder = objnSpace.Folders(strFolderName).Folders(FolderName(i)).Folders ("completed")
On Error GoTo 0
If objFolder Is Nothing Then GoTo skip
For Each MailItem In objFolder.Items
If DatePart("d", Date - 1) = DatePart("d", MailItem.ReceivedTime) Then EmailCount = EmailCount + 1
Next
skip:
Next
MsgBox "Completed Email Totals from Yesterday: " & EmailCount
End Sub

Answer 1

Found this out through trial and error, but returns what I need.
Sub Tester()
'Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim MailItem
Dim EmailCount() As Integer, arrNames
Dim completed, x As Long, num As Long
Dim DayTotal
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
arrNames = Array("Ashton", "Beth", "Bree", "Brittany", "Cecilia", "Chance", "Christina", "Christine", "Dustin", "James", "Jeff", "Jenni", "Jennifer", "Jeromy", "Josh", "Josie", "Lisa", "Misti", "Nathan", "Paul", "Robert", "Sam", "Shane", "Shawna") 'add other names here...
ReDim EmailCount(LBound(arrNames) To UBound(arrNames))
For x = LBound(arrNames) To UBound(arrNames)
On Error Resume Next
Set objFolder = objnSpace.Folders("Mailbox - IT Support Center"). _
Folders("Onshore - " & arrNames(x)).Folders("completed")
On Error GoTo 0
num1 = 0
num2 = 0
num3 = 0
num4 = 0
num5 = 0
num6 = 0
num7 = 0
Dim Totalmsg
If Not objFolder Is Nothing Then
For Each MailItem In objFolder.Items
If DateValue(Date - 1) = _
DateValue(MailItem.ReceivedTime) Then num1 = num1 + 1
If DateValue(Date - 2) = _
DateValue(MailItem.ReceivedTime) Then num2 = num2 + 1
If DateValue(Date - 3) = _
DateValue(MailItem.ReceivedTime) Then num3 = num3 + 1
If DateValue(Date - 4) = _
DateValue(MailItem.ReceivedTime) Then num4 = num4 + 1
If DateValue(Date - 5) = _
DateValue(MailItem.ReceivedTime) Then num5 = num5 + 1
If DateValue(Date - 6) = _
DateValue(MailItem.ReceivedTime) Then num6 = num6 + 1
If DateValue(Date - 7) = _
DateValue(MailItem.ReceivedTime) Then num7 = num7 + 1
Next
Dim DayTotal1 As String
Dim DayTotal2 As String
Dim DayTotal3 As String
Dim DayTotal4 As String
Dim DayTotal5 As String
Dim DayTotal6 As String
Dim DayTotal7 As String
DayTotal1 = arrNames(x) & " " & (Date - 1) & " " & num1
DayTotal2 = arrNames(x) & " " & (Date - 2) & " " & num2
DayTotal3 = arrNames(x) & " " & (Date - 3) & " " & num3
DayTotal4 = arrNames(x) & " " & (Date - 4) & " " & num4
DayTotal5 = arrNames(x) & " " & (Date - 5) & " " & num5
DayTotal6 = arrNames(x) & " " & (Date - 6) & " " & num6
DayTotal7 = arrNames(x) & " " & (Date - 7) & " " & num7
DayTotal = DayTotal1 & vbNewLine _
& DayTotal2 & vbNewLine _
& DayTotal3 & vbNewLine _
& DayTotal4 & vbNewLine _
& DayTotal5 & vbNewLine _
& DayTotal6 & vbNewLine _
& DayTotal7 & vbNewLine _
DayTotals = DayTotals & DayTotal
msg = arrNames(x) & " " & (Date - 1) & " " & num1 & vbNewLine _
& arrNames(x) & " " & (Date - 2) & " " & num2 & vbNewLine _
& arrNames(x) & " " & (Date - 3) & " " & num3 & vbNewLine _
& arrNames(x) & " " & (Date - 4) & " " & num4 & vbNewLine _
& arrNames(x) & " " & (Date - 5) & " " & num5 & vbNewLine _
& arrNames(x) & " " & (Date - 6) & " " & num6 & vbNewLine _
& arrNames(x) & " " & (Date - 7) & " " & num7
' Totalmsg = msg
End If
Debug.Print arrNames(x), num
Next x
MsgBox DayTotals
Set OutApp = CreateObject("outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.Subject = "Total Completed Tickets"
.To = "plotnerj#schneider.com"
.Body = DayTotals
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub