Question

我正在尝试将传入电子邮件的主题与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

Answer 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

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

1 个答案: