vba가 동적으로 다른 폴더를 반복합니다.

Question

이 모든 것을 하드 코딩하지 않고 25 개의 다른 폴더에서 검색하고 싶습니다. 폴더 경로는 모두에 대해 동일합니다. 폴더는 "Mailbox It Support Center"/ 여기에 다른 사람의 이름/"completed"나는 당신이 내가하고있는 것을 볼 수 있도록 아래의 처음 두 개를 가지고 있습니다. 각 에 대해이라는 사서함 이름을 모두 검색 할 수 있지만이를 반복하는 방법을 알아야한다고 생각합니다. 이 같은

하위 CompletedEmailsDailyCount()

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder 
Dim MailItem 
Dim EmailCount As Integer, EmailCount1 As Integer, EmailCount2 As Integer, EmailCount3 As  Integer, EmailCount4 As Integer 
Dim EmailCount5 As Integer, EmailCount6 As Integer, EmailCount7 As Integer, EmailCount8 As  Integer, EmailCount9 As Integer 
Dim EmailCount10 As Integer, EmailCount11 As Integer, EmailCount12 As Integer,  EmailCount13 As Integer, EmailCount14 As Integer 
Dim EmailCount15 As Integer, EmailCount16 As Integer, EmailCount17 As Integer,  EmailCount18 As Integer, EmailCount19 As Integer 
Dim EmailCount20 As Integer, EmailCount21 As Integer, EmailCount22 As Integer,  EmailCount23 As Integer, EmailCount24 As Integer 
Dim EmailCount25 As Integer 
Dim completed 

Set objOutlook = CreateObject("Outlook.Application") 
Set objnSpace = objOutlook.GetNamespace("MAPI") 
On Error Resume Next 

Set objFolder = objnSpace.Folders("Mailbox - IT Support Center").Folders("Onshore - Josh").Folders("completed") 
    On Error GoTo 0 
    ' check the folder so it exists 
    If objFolder Is Nothing Then MsgBox "No Such Folder": Exit Sub 
    ' check through all mailitems in this folder for if the date matches yesterdays, if so, add one to emailcount 
    For Each MailItem In objFolder.Items 
    If DateValue(Date - 1) = DateValue(MailItem.ReceivedTime) Then EmailCount15 = EmailCount15 + 1 
    Next 
    completed = completed + EmailCount15 'adds the completes from this mailbox to running total 

Set objFolder1 = objnSpace.Folders("Mailbox - IT Support Center").Folders("Onshore - Ashton").Folders("completed") 
    On Error GoTo 0 
    If objFolder1 Is Nothing Then MsgBox "No Such Folder": Exit Sub 
    For Each MailItem In objFolder1.Items 
    If DateValue(Date - 1) = DateValue(MailItem.ReceivedTime) Then EmailCount1 = EmailCount1 + 1 
    Next 
    completed = completed + EmailCount1 

Answer 1

안된하지만 뭔가 작업을해야합니다 :

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 

    Set objOutlook = CreateObject("Outlook.Application") 
    Set objnSpace = objOutlook.GetNamespace("MAPI") 

    arrNames = Array("Josh", "Ashton") '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 

     num = 0 
     If Not objFolder Is Nothing Then 
      For Each MailItem In objFolder.Items 
       If DateValue(Date - 1) = _ 
         DateValue(MailItem.ReceivedTime) Then num = num + 1 
      Next 
     End If 
     EmailCount(x) = num 
     completed = completed + num 

     Debug.Print arrNames(x), num 

    Next x 

End Sub