Question

我写了一个VBA程序，应该从我的Outlook帐户下载和复制电子邮件，然后将它们粘贴到我的Excel电子表格中。我想每天运行这个程序，所以很明显，我不希望每次都通过我的整个邮箱。所以，我希望它能够在最后复制的电子邮件日期之后开始搜索电子邮件。但是当我尝试运行它时，它不起作用。它不断浏览整个邮箱并向后循环。例如，它将查找2015年6月29日的电子邮件，然后转到2015年6月28日，2015年6月27日等等，这与我想要完成的工作相反。我不确定我做错了什么。任何帮助将非常感激。提前谢谢！

 Sub Download_Outlook_Mail_To_Excel()
        Dim Folder As Outlook.MAPIFolder
        Dim iRow As Integer, oRow As Integer, fRow As Integer

        Dim MailBoxName As String, Pst_Folder_Name  As String


        MailBoxName = "officework@gmail.com"

        Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items"

        Set Folder =   
        Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)
        If Folder = "" Then
            MsgBox "Invalid Data in Input"
            GoTo end_lbl1:
        End If


        ThisWorkbook.Sheets(1).Activate
        Folder.Items.Sort "Received"

      '  Insert Column Headers
      '  ThisWorkbook.Sheets(1).Cells(1, "A") = "Sender"
      '  ThisWorkbook.Sheets(1).Cells(1, "D") = "Subject"
      '  ThisWorkbook.Sheets(1).Cells(1, "F") = "Date"
      '  ThisWorkbook.Sheets(1).Cells(1, "J") = "EmailID"
      '  ThisWorkbook.Sheets(1).Cells(1, "M") = "Body"



        LastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        vDate = Cells(LastRow, "F").Value


        For fRow = 1 To Folder.Items.Count
        If Folder.Items.Item(fRow).ReceivedTime >= vDate Then


        For iRow = LastRow To Folder.Items.Count
            oRow = iRow + 1
            ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
            ThisWorkbook.Sheets(1).Cells(oRow, "A") = Folder.Items.Item(iRow).SenderName
            ThisWorkbook.Sheets(1).Cells(oRow, "D") = Folder.Items.Item(iRow).Subject
            ThisWorkbook.Sheets(1).Cells(oRow, "F") = Folder.Items.Item(iRow).ReceivedTime
            ThisWorkbook.Sheets(1).Cells(oRow, "J") = Folder.Items.Item(iRow).SenderEmailAddress
            ThisWorkbook.Sheets(1).Cells(oRow, "M") = Folder.Items.Item(iRow).Body
        Next iRow
        End If
        Next fRow

        MsgBox "Outlook Mails Extracted to Excel"


    end_lbl1:
    End Sub

Answer 1

我注意到以下几行代码：

For fRow = 1 To Folder.Items.Count
   If Folder.Items.Item(fRow).ReceivedTime >= vDate Then

看起来您正在遍历文件夹中的每个项目并检查RecievedTime属性。迭代文件夹中的所有项目并不是一个好主意。因此，我建议您使用Items类的Find / FindNext或Restrict方法。后者将过滤器应用于Items集合，返回一个新集合，其中包含原始中与过滤器匹配的所有项目。因此，您只需要遍历少量项目并执行您需要的任何操作，而无需每次都检查属性。您可以在以下文章中阅读有关这些方法的更多信息：

How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)

How To: Use Restrict method to retrieve Outlook mail items from a folder

日期和时间通常以Date格式存储，但Find和Restrict方法要求将日期和时间转换为字符串表示形式。要确保将日期格式设置为Microsoft Outlook所需的格式，请使用格式化功能（在VBA中可用）：

 sFilter = "[RecevedTime] > '" & Format("6/29/2015 9:30pm", "ddddd h:nn AMPM") & "'"

另外，您可能会发现Application类的AdvancedSearch方法很有帮助。在Outlook中使用AdvancedSearch方法的主要好处是：

搜索在另一个线程中执行。您不需要手动运行另一个线程，因为AdvancedSearch方法会在后台自动运行它。
可以在任何位置搜索任何项目类型：邮件，约会，日历，备注等，即超出某个文件夹的范围。 Restrict和Find / FindNext方法可以应用于特定的Items集合（请参阅Outlook中Folder类的Items属性）。
完全支持DASL查询（自定义属性也可用于搜索）。您可以在MSDN中的过滤文章中阅读有关此内容的更多信息。要提高搜索性能，如果为商店启用了即时搜索，则可以使用即时搜索关键字（请参阅Store类的IsInstantSearchEnabled属性）。
您可以随时使用Search类的Stop方法停止搜索过程。

有关详细信息，请参阅Advanced search in Outlook programmatically: C#, VB.NET。

最后，请查看MSDN中的Getting Started with VBA in Outlook 2010文章，该文章介绍了Outlook编程的基础知识。

Answer 2

我在Eugene发布他之前就开始了我的回答，但后来完成了因为我试图并行做其他事情。他的回答提供了很好的建议，你的代码会更好地遵循这些建议。我的代码与您的代码更接近，因此您可能会发现在开发过程中作为VBA程序员更容易理解。

我想我知道你的代码有什么问题，但首先是一些一般的建议。

将Option Explicit放在模块的顶部意味着必须正确声明所有变量。您的一些变量已定义，但其他变量未定义。如果您使用未使用Dim语句声明的变量，VBA将为您声明Variant。类型Variant的变量可以采用任何类型的值，这些值很慢且容易出错。考虑：

X = 5
X = “A”

在上面的代码中，我没有声明X所以它是Variant。将X设置为5，然后将“A”设置为Variants的有效代码。将这两个陈述放在一起使我容易发现错误。但是如果我在整个宏中使用X，那么将X设置为错误类型的值的语句可能很难被发现并且可能导致奇怪的失败。

Dim X as Long
X = 5
X = “A”

添加Dim语句意味着解释器将在运行时拒绝X = “A”。

如果在For-Next循环和If-Else-EndIf块中缩进代码，则遵循代码会变得更加容易。我怀疑这是你的一个问题。

你的另一个问题是使用毫无意义的名字。你有iRow，oRow，fRow和LastRow。也许这些名称背后有一个系统，但它看起来并非如此。如果有系统，当您需要在六个月或十二个月内更新此宏时，您会记住该系统吗？我有一个命名变量系统，这意味着我可以查看十年前写的宏，并立即知道所有变量是什么。

我的变量名称都是单词或缩写的序列。第一个字总是我使用变量，所以“行”意味着它是一个行号。下一个词定义了它的一行。您有Excel工作表和Outlook文件夹的行，所以可能是“RowSht”和“RowFld”或“RowEx”和“RowOut”。有时我需要第四个字，但通常三个就足够了。对于行号，第三个字通常是“Crnt”（对于当前），First，Last或Next。

我可以对你的代码提出其他一些要点，但我认为现在已经足够了。

我认为主要问题是你通过文件夹的行有一个外循环和一个内循环。您选择的变量名称很难识别，

第1期

Dim RcvdPrevLatest as Date
Dim RowShtCrnt as Long

RowShtCrnt = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
RcvdPrevLatest = Cells(LastRow, "F").Value
RowShtCrnt = RowShtCrnt + 1

您只需要一个变量用于工作表的行，因此我将其命名为RowShtCrnt。我已将其声明为Long，因为Integer声明了一个16位变量，需要在32位和64位计算机上进行特殊处理，并且因为Integer仅允许64K行小于最大行数，除非您使用的是Excel 2003。

我已为您的日期声明了一个变量。我的系统迫使我思考变量的目的。它保持一个接收日期/时间，所以第一个单词是“Rcvd”。保留的特定接收日期/时间是上一次运行宏的最新收到日期/时间。

第2期

你有：

For fRow = 1 To Folder.Items.Count
  If Folder.Items.Item(fRow).ReceivedTime >= vDate Then
    For iRow = LastRow To Folder.Items.Count

外部For循环在文件夹中搜索邮件项目，其收到的日期/时间晚于上一个最新日期/时间。然后内部For-Loop输出文件夹下面的每个邮件项目，以便您重复输出邮件项目。内部For循环在工作表的最后一行启动iRow并继续到文件夹的最后一行。您选择的名称使得很难发现起始值和结束值彼此不相关。由于内部循环中未使用fRow，因此其值对选择输出的邮件项没有影响。

我没有测试过这段代码，但它会更接近你想要的东西：

Dim RowFldCrnt as Long

For RowFldCrnt = 1 To Folder.Items.Count
  If Folder.Items.Item(RowFldCrnt).ReceivedTime > RcvdPrevLatest Then
    ThisWorkbook.Sheets(1).Cells(RowShtCrnt, "A") = _
                   Folder.Items.Item(RowFldCrnt).SenderName
    ThisWorkbook.Sheets(1).Cells(RowShtCrnt, "D") = _
                   Folder.Items.Item(RowFldCrnt).Subject 
       : : :
    RowShtCrnt = RowShtCrnt + 1
Next

从outlook复制

2 个答案: