Итерировать все элементы электронной почты в определенной папке Outlook


6

Как я могу в макросе Outlook VBA перебирать все элементы электронной почты в определенной папке Outlook (в этом случае папка принадлежит не моему личному inbux, а является подпапкой для папки входящих сообщений из общего почтового ящика.

Что-то вроде этого, но я никогда не делал макрос Outlook, ...

For each email item in mailboxX.inbox.mySubfolder.items 
// do this 
next item 

Я попытался это, но папка Входящие вложенная папка не найдена ...

Private Sub Application_Startup() 

Dim objNS As Outlook.NameSpace 
Dim objFolder As Outlook.MAPIFolder 
Set objNS = GetNamespace("MAPI") 
Set objFolder = objNS.Folders("myGroupMailbox") 
Set objFolder = objFolder.Folders("Inbox\mySubFolder1\mySubFolder2") 

    On Error GoTo ErrorHandler 
    Dim Msg As Outlook.MailItem 

For Each Item In objFolder.Items 

    If TypeName(Item) = "MailItem" Then 

    Set Msg = Item 
    If new_msg.Subject Like "*myString*" Then 
     strBody = myItem.Body 
     Dim filePath As String 
     filePath = "C:\myFolder\test.txt" 
     Open filePath For Output As #2 
     Write #2, strBody 
     Close #2 

    End If 

    End If 

ProgramExit: 
    Exit Sub 
ErrorHandler: 
    MsgBox Err.Number & " - " & Err.Description 
    Resume ProgramExit 

Next Item 

End Sub 
  0

Что бит вы боретесь с? «Как выбрать правильную подпапку»? 04 фев. 142014-02-04 15:25:14

  0

Да, но я никогда не делал макрос Outlook и хочу только итерировать эту папку с помощью простых действий, но примеры, которые я нашел, выглядят довольно сложными. Нужно ли что-нибудь еще добавить для запуска цикла? 04 фев. 142014-02-04 15:38:16

  0

Получено ли сообщение об ошибке или оно не находит что-то, что вы знаете? В любом случае, я думаю, что вы должны переместить строку 'next item' до метки' ProgramExit', в настоящий момент вы выйдете из подпрограммы до ее достижения. 05 фев. 142014-02-05 23:44:52

3

Формат:

Set objFolder = objFolder.Folders("Inbox").Folders("mySubFolder1").Folders("mySubFolder2") 

Как сообщил в комментарии «перейти на следующую строку элемента, чтобы перед меткой ProgramExit»


2

В моем случае следующие работали:

Sub ListMailsInFolder() 

    Dim objNS As Outlook.NameSpace 
    Dim objFolder As Outlook.MAPIFolder 

    Set objNS = GetNamespace("MAPI") 
    Set objFolder = objNS.Folders.GetFirst ' folders of your current account 
    Set objFolder = objFolder.Folders("Foldername").Folders("Subfoldername") 

    For Each Item In objFolder.Items 
     If TypeName(Item) = "MailItem" Then 
      ' ... do stuff here ... 
      Debug.Print Item.ConversationTopic 
     End If 
    Next 

End Sub 

Кроме того, вы может и перебирать каландра пунктов:

Private Sub ListCalendarItems() 
     Set olApp = CreateObject("Outlook.Application") 
     Set olNS = olApp.GetNamespace("MAPI") 

     Set olRecItems = olNS.GetDefaultFolder(olFolderTasks) 
     strFilter = "[DueDate] > '1/15/2009'" 
     Set olFilterRecItems = olRecItems.Items.Restrict(strFilter) 
     For Each Item In olFilterRecItems 
     If TypeName(Item) = "TaskItem" Then 
      Debug.Print Item.ConversationTopic 
     End If 
    Next 
End Sub 

Примечание, что этот пример использует фильтрацию, а также .GetDefaultFolder(olFolderTasks), чтобы получить встроенную папку для элементов календаря. Если вы хотите получить доступ к почтовому ящику, например, используйте olFolderInbox.


1
Sub TheSub() 

Dim objNS As Outlook.NameSpace 
Dim fldrImAfter As Outlook.Folder 
Dim Message As Outlook.MailItem 

    'This gets a handle on your mailbox 
    Set objNS = GetNamespace("MAPI") 

    'Calls fldrGetFolder function to return desired folder object 
    Set fldrImAfter = fldrGetFolder("Folder Name Here", objNS.Folders) 

    For Each Message In fldrImAfter.Items 
     MsgBox Message.Subject 
    Next 

End Sub 

Рекурсивные функции в цикле по всем папкам, пока указанное имя папки найден ....

Function fldrGetFolder(_ 
        strFolderName As String _ 
        , objParentFolderCollection As Outlook.Folders _ 
        ) As Outlook.Folder 

Dim fldrSubFolder As Outlook.Folder 

    For Each fldrGetFolder In objParentFolderCollection 

     'MsgBox fldrGetFolder.Name 

     If fldrGetFolder.Name = strFolderName Then 
      Exit For 
     End If 

     If fldrGetFolder.Folders.Count > 0 Then 
      Set fldrSubFolder = fldrGetFolder(strFolderName, 
fldrGetFolder.Folders) 
      If Not fldrSubFolder Is Nothing Then 
       Set fldrGetFolder = fldrSubFolder 
       Exit For 
      End If 
     End If 

    Next 

End Function