从 Outlook 检索电子邮件的 Excel VBA 代码 [英] Excel VBA Code to retrieve e-mails from outlook

问题描述

我将编写一个 VBA 代码，根据特定条件从 Outlook 检索电子邮件.我遇到的问题是我必须在我的代码中表示某个文件夹(在下面的示例中，表示的文件夹是PRE Costumer".我想从我的收件箱"或更好的情况下从所有 Outlook 文件夹中检索所有电子邮件. 问题是我的收件箱包含许多子文件夹(因为规则 0.我的问题是我可能不知道所有子文件夹名称(因为许多用户将使用宏，甚至有人可以在个人文件夹中拥有电子邮件).
请问有没有办法解决这个问题?
请让我知道这个问题是否含糊(因为我是新人)

I am to write a VBA code that would retrive emails from Outlook based on certain conditions. The problem I have is that I have to denote a certain folder in my code (in the example below the folder denoted is "PRE Costumer". I would like to retrive all emails from my 'inbox' or in better case from all outlook folders. The problem is that my inbox consists of many subfolders (because of rules0. My problem is that I may not know all the subfolders names (as many useres are going to use the macro and even someone can have the e mails in Personal Folders).
Could you please advise is there a way to overcome this problem?
Please let me know if this question is vague (as I am newcomer)

请找到我有问题的标有注释的行.

Please find the line that I have probelm with marked with a comment.

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

推荐答案

只需遍历 Inbox 中的所有文件夹即可.
像这样的东西会起作用.

Just loop through all the folders in Inbox.
Something like this would work.

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

Above 处理 Inbox 中的所有子文件夹.
这是你正在尝试的吗?

Above takes care of all subfolders in Inbox.
Is this what you're trying?

这篇关于从 Outlook 检索电子邮件的 Excel VBA 代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！