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

问题描述

我要编写一个VBA代码，可以根据某些条件从Outlook中检索电子邮件。我的问题是我必须在我的代码中表示某个文件夹（在下面的示例中，表示为PRE Costumer的文件夹，我想从我的收件箱中或从更好的情况下从所有outlook文件夹中删除所有电子邮件问题是我的收件箱由许多子文件夹组成（因为rules0）我的问题是我可能不知道所有的子文件夹名称（因为许多用户将使用宏，甚至有人可以在个人文件夹中使用电子邮件） 。

请问你有没有办法克服这个问题？

请让我知道这个问题是否含糊（因为我是新人）

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

推荐答案

循环访问收件箱中的所有文件夹。

这样的东西可以工作。

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 takes care of all subfolders in Inbox.
Is this what you're trying?

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