web-dev-qa-db-ja.com

特定のOutlookフォルダ内のすべての電子メールアイテムを繰り返します

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
vbaoutlook
8
user3271332

形式は次のとおりです。

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

コメントでアドバイスされているように、「次のアイテム行をProgramExitラベルの前に移動します」

3
niton

私の場合、以下が機能しました。

_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を使用します。

2
Matt
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
2
DonkeyKong