하위 폴더 용 Outlook의 전자 메일을 추출하는 방법

Question

OfficeTricks.com에있는 Outlook에서 전자 메일을 받기위한이 고급 매크로를 찾았습니다.

그러나 하위 폴더가 1 층 아래로 내려간 것으로 보입니다. 하위 폴더를 2 ~ 3 층 내려갈 수있는 방법이 있습니까?

Option Explicit 
'This Code is Downloaded from OfficeTricks.com 
'Visit this site for more such Free Code 
Sub VBA_Export_Outlook_Emails_To_Excel() 
    'Add Tools->References->"Microsoft Outlook nn.n Object Library" 
    'nn.n varies as per our Outlook Installation 
    Dim Folder As Outlook.MAPIFolder 
    Dim sFolders As Outlook.MAPIFolder 
    Dim iRow As Integer, oRow As Integer 
    Dim MailBoxName As String, Pst_Folder_Name As String 

    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session) 
    MailBoxName = "Clauric@ABC.com" 

    'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session) 
    Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items" 

    'To directly a Folder at a high level 
    'Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name) 

    'To access a main folder or a subfolder (level-1) 
    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders 
     If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found 
     For Each sFolders In Folder.Folders 
      If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then 
       Set Folder = sFolders 
       GoTo Label_Folder_Found 
      End If 
     Next sFolders 
    Next Folder 

Label_Folder_Found: 
    If Folder.Name = "" Then 
     MsgBox "Invalid Data in Input" 
     GoTo End_Lbl1: 
    End If 

    'Read Through each Mail and export the details to Excel for Email Archival 
    ThisWorkbook.Sheets(1).Activate 
    Folder.Items.Sort "Received" 

    'Insert Column Headers 
    ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender" 
    ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject" 
    ThisWorkbook.Sheets(1).Cells(1, 3) = "Date" 
    ThisWorkbook.Sheets(1).Cells(1, 4) = "Size" 
    ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID" 
    ThisWorkbook.Sheets(1).Cells(1, 6) = "Body" 

    'Export eMail Data from PST Folder to Excel with date and time 
    oRow = 1 
    For iRow = 1 To Folder.Items.Count 
     'If condition to import mails received in last 60 days 
     'To import all emails, comment or remove this IF condition 
     If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then 
      oRow = oRow + 1 
      ThisWorkbook.Sheets(1).Cells(oRow, 1).Select 
      ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName 
      ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject 
      ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime 
      ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size 
      ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress 
      ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body 
     End If 
    Next iRow 
    MsgBox "Outlook Mails Extracted to Excel" 
    Set Folder = Nothing 
    Set sFolders = Nothing 

End_Lbl1: 
End Sub 

I 아래, 예를 들어 폴더를 1 층으로 Pst_Folder_Name를 변경하려고하면 Pst_Folder_Name = "Operations", 작동합니다. 개체 변수 또는 With 블록 변수가

설정되지 않은 : 나는 Pst_Folder_Name = "Manufacturing", 또는 Pst_Folder_Name = "Operations/Manufacturing"와 같은 작업의 하위 폴더를 시도 할 경우, 나는

런타임 오류 메시지가 '91'취득 에서 If Folder.Name = "" Then

Answer 1

재귀를 찾는 것이 아니라 수동으로 트리에서 폴더를 참조하는 경우.

원하는만큼 추가하십시오.

'To access a subfolder (level-1) or a subfolder (level-2) 
For Each Folder In Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name).Folders 
    If VBA.UCase(Folder.Name) = VBA.UCase(Oneleveldeeper_Folder_Name) Then GoTo Label_Folder_Found 
    For Each sFolders In Folder.Folders 
     If VBA.UCase(sFolders.Name) = VBA.UCase(Oneleveldeeper_Folder_Name) Then 
      Set Folder = sFolders 
      GoTo Label_Folder_Found 
     End If 
    Next sFolders 
Next Folder 

'To access a subfolder (level-2) or a subfolder (level-3) 
For Each Folder In Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name).Folders(Oneleveldeeper_Folder_Name).Folders 
    If VBA.UCase(Folder.Name) = VBA.UCase(Twolevelsdeeper_Folder_Name) Then GoTo Label_Folder_Found 
    For Each sFolders In Folder.Folders 
     If VBA.UCase(sFolders.Name) = VBA.UCase(Twolevelsdeeper_Folder_Name) Then 
      Set Folder = sFolders 
      GoTo Label_Folder_Found 
     End If 
    Next sFolders 
Next Folder