按名称循环遍历子文件夹答案

【问题标题】：Loop through subfolders by name按名称循环遍历子文件夹
【发布时间】：2013-12-26 19:19:50
【问题描述】：

文件夹路径是"Mailbox - IT Support Center"\"Onshore - Josh"\"Completed"。

我想知道每个人昨天完成的邮箱中的电子邮件总数。
大约有 25 个邮箱，但它们都遵循相同的路径，从 邮箱 - IT 支持中心开始。

除了循环之外，脚本都可以工作。它迭代到第二个文件夹，但它仍然搜索第一个邮箱。 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

【问题讨论】：

你说文件夹的路径是文件夹路径是“邮箱 - IT Support Center”\“Onshore - Josh”\“Completed”......但是这些是公共文件夹吗？您是否正在从您的个人资料连接到共享收件箱？需要更多信息
是的，这些是共享文件夹。每个代理都有一个与 Onshore 共享的文件夹——“他们的名字”，然后在每个代理中都有一个完整的文件夹。
您正在收件箱中查找这些共享文件夹，请查看几个级别。 objnSpace.Folders - 应该为您提供配置文件中所有文件夹的列表。
我能够准确地访问文件夹，问题出在循环。当我将鼠标悬停在文件夹名称（i）上时，它确实显示了下一个文件夹（Ashton），但是当悬停在 objFolder.Items 中的 For Each MailItem 上时，它会查看来自第一个代理（Josh）的相同 10 封电子邮件

标签： vba outlook

【解决方案1】：

通过反复试验发现了这一点，但返回了我需要的东西。

子测试器()

'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

【讨论】：