web-dev-qa-db-ja.com

Outlookから電子メールを取得するためのExcel VBAコード

特定の条件に基づいてOutlookから電子メールを取得するVBAコードを記述します。私の問題は、コード内の特定のフォルダーを示す必要があることです（以下の例では、「PREコスチューム」と表示されているフォルダーです。「受信トレイ」から、またはすべてのOutlookフォルダーからすべてのメールを取得したいと思います。 。問題は、私の受信トレイが多数のサブフォルダで構成されていることです（rules0のため）。私の問題は、すべてのサブフォルダ名がわからない可能性があることです（多くのユーザーがマクロを使用し、誰かが個人用フォルダに電子メールを持っている可能性があるため）。 。
この問題を解決する方法はありますか。
この質問が曖昧な場合は知らせてください（私は初めてなので）

私が問題を抱えている行にコメントが付いている行を見つけてください。

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
'Below is the line I have problem with
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer") 

i = 1
x = Date

For Each olMail In Fldr.Items
    If InStr(olMail.Subject, "transactions") > 0 _
    And InStr(olMail.ReceivedTime, x) > 0 Then  
        ActiveSheet.Cells(i, 1).Value = olMail.Subject
        ActiveSheet.Cells(i, 2).Value = olMail.ReceivedTime
        ActiveSheet.Cells(i, 3).Value = olMail.SenderName
        i = i + 1
    End If
Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
vbaexcel-vbaoutlook-vbaexcel
8
Artur Rutkowski

Inbox内のすべてのフォルダーをループするだけです。
このようなものが機能します。

Edit1：これにより、空白行が回避されます。

Sub test()
    Dim olApp As Outlook.Application, olNs As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder, olMail As Outlook.MailItem
    Dim eFolder As Outlook.Folder '~~> additional declaration
    Dim i As Long
    Dim x As Date, ws As Worksheet '~~> declare WS variable instead
    Dim lrow As Long '~~> additional declaration

    Set ws = Activesheet '~~> or you can be more explicit using the next line
    'Set ws = Thisworkbook.Sheets("YourTargetSheet")
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    x = Date

    For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
        'Debug.Print eFolder.Name
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
        For i = olFolder.Items.Count To 1 Step -1
            If TypeOf olFolder.Items(i) Is MailItem Then
                Set olMail = olFolder.Items(i)
                If InStr(olMail.Subject, "transactions") > 0 _
                And InStr(olMail.ReceivedTime, x) > 0 Then
                    With ws
                       lrow = .Range("A" & .Rows.Count).End(xlup).Row
                       .Range("A" & lrow).Offset(1,0).value = olMail.Subject
                       .Range("A" & lrow).Offset(1,1).Value = olMail.ReceivedTime
                       .Range("A" & lrow).Offset(1,2).Value = olMail.SenderName
                    End With
                End If
            End If
        Next i
        Set olFolder = Nothing
    Next eFolder
End Sub

上記は、Inbox内のすべてのサブフォルダーを処理します。
これはあなたがしようとしていることですか？

12
L42