将电子邮件与 Masterlist Excel 文件匹配答案

【问题标题】：Match email with Masterlist Excel File将电子邮件与 Masterlist Excel 文件匹配
【发布时间】：2020-06-28 09:29:53
【问题描述】：

我正在尝试将传入电子邮件的主题与 Excel 主列表相匹配，以查看该电子邮件之前是否已经存在/提取。如果匹配或存在，那么它将显示某些内容或从电子邮件中提取消息。

下面的代码没有显示任何结果。

Public Sub MatchAutoAckv1()

    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim obj As Object

    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items

    Dim myItem As MailItem

    Dim StrBody As String
    Dim TotalRows As Long, i As Long

    Dim myXLApp As Excel.Application
    Dim myXLWB As Excel.Workbook
    Dim exSubj As String

    Set objOL = Outlook.Application
    Set objNS = Application.Session
    Set objFolder = Session.GetDefaultFolder(olFolderInbox).Folders("For Processing")
    Set objItems = objFolder.Items

    Set myXLApp = New Excel.Application
    myXLApp.Visible = True
    Set myXLWB = myXLApp.Workbooks.Open("C:\Users\username\Desktop\SR Automation Project\SR Historyv2.xlsx")

    Set excWks = myXLWB.Worksheets("Sheet1")

    lgLastRow = excWks.Range("C65536").End(xlUp).Row
    i = lgLastRow + 1

    Dim lgCurrentRow As Long

    For Each obj In objItems

        For lgCurrentRow = 2 To lgLastRow
            Cells(lgCurrentRow, "C") = exSubj

            If obj.Subject = exSubj Then

                Debug.Print obj.Subject

            End If

        Next

    Next

    Set obj = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
End Sub

【问题讨论】：

标签： excel vba outlook

【解决方案1】：

我建议您始终使用 Option Explicit。如果你不知道如何声明一个变量，就让它不带类型。

Dim Variable ' as nothing becomes Variant

试试这个：

Option Explicit

Public Sub MatchAutoAckv1()

    'Dim objNS As Namespace
    'Dim objFolder As MAPIFolder ' 2003 and older
    Dim objFolder As folder
    Dim obj As Object

    'Dim objOL As Outlook.Application
    Dim objItems As Items

    'Dim myItem As mailItem

    'Dim StrBody As String
    'Dim TotalRows As Long
    'Dim i As Long
    Dim lgLastRow As Long
    Dim lgCurrentRow As Long

    Dim myXLApp As Excel.Application
    Dim myXLWB As Excel.Workbook

    Dim excWks As Excel.Worksheet

    Dim exSubj As String

    'Set objOL = Outlook.Application
    'Set objNS = Application.Session

    Set objFolder = Session.GetDefaultFolder(olFolderInbox).Folders("For Processing")
    Set objItems = objFolder.Items

    Set myXLApp = New Excel.Application
    myXLApp.Visible = True
    Set myXLWB = myXLApp.Workbooks.Open("C:\Users\username\Desktop\SR Automation Project\SR Historyv2.xlsx")

    Set excWks = myXLWB.Worksheets("Sheet1")

    lgLastRow = excWks.range("C65536").End(xlUp).Row
    'i = lgLastRow + 1

    'Likely more efficient with loops reversed
    'For Each obj In objItems

    For lgCurrentRow = 2 To lgLastRow

        ' This is the wrong way round
        'excWks.Cells(lgCurrentRow, "C") = exSubj
        exSubj = excWks.Cells(lgCurrentRow, "C")
        Debug.Print
        Debug.Print exSubj

        For Each obj In objItems
            If obj.subject = exSubj Then
                Debug.Print "- " & obj.subject
            End If
        Next

    Next

    myXLWB.Close olDiscard
    myXLApp.Quit

ExitRoutine:

    Set obj = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    'Set objOL = Nothing

    Set myXLApp = Nothing
    Set myXLWB = Nothing
    Set excWks = Nothing

End Sub

【讨论】：