Excel 在同一Outlook mail.item主题中搜索多个关键字

Excel 在同一Outlook mail.item主题中搜索多个关键字,excel,vba,outlook,Excel,Vba,Outlook,我在Outlook电子邮件的主题中有多个关键字。关键词不是每次都按相同的顺序排列,而是存在的 我有找到其中一个关键字的代码,但无法搜索所有关键字 在这种情况下,我如何处理差异。有些邮件主题是大写的,有些是小写的,有些是混合的 Tuf PHS提货单:SD 19704802 TUF PHS提货单SD/19704796 我复习了很多文章。有些是有帮助的,但我找不到一个字符串组合,可以用于主题中的多个关键字 Sub ExtractandPrintTufnelOders() Dim myOlApp As

我在Outlook电子邮件的主题中有多个关键字。关键词不是每次都按相同的顺序排列,而是存在的

我有找到其中一个关键字的代码,但无法搜索所有关键字

在这种情况下,我如何处理差异。有些邮件主题是大写的,有些是小写的,有些是混合的

Tuf PHS提货单:SD 19704802
TUF PHS提货单SD/19704796

我复习了很多文章。有些是有帮助的,但我找不到一个字符串组合,可以用于主题中的多个关键字

Sub ExtractandPrintTufnelOders()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim Found As Boolean
Dim Unread As Long

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.Folders("xxx@xxx.co.uk")
Set myInbox = myInbox.Folders("Inbox")
Set myitems = myInbox.Items
Found = False

For Each myitem In myitems.Restrict("[Unread] = true")
    If myitem.Class = olMail Then

        If InStr(1, myitem.Subject, "Tuf" & "Picking List") > 0 Or _
          InStr(1, myitem.Subject, "TUF" & "PICKING LIST") > 0 Or _
          InStr(1, myitem.Subject, "Tuf" & "Picking List:") > 0 Or _
          InStr(1, myitem.Subject, "tuf" & "picking list") > 0 Then
            Debug.Print "Found a Tufnels Picking List"
            Found = True
            If Found = True Then
            End If
        End If
    End If
Next myitem

'If the subject isn't found:
If Not Found Then
'NoResults.Show
End If

'myOlApp.Quit
Set myOlApp = Nothing
Debug.Print myInbox.UnReadItemCount
End Sub

但是,如果我将字符串缩减为“Tuf”,则会输出一个肯定的结果。

首先,您也可以对主题应用过滤器,并将它们组合在一起

criteria = "@SQL=" & Chr(34) _ 
& "urn:schemas:httpmail:subject" & Chr(34) _ 
& " ci_phrasematch 'picking List'" 
ci\u phrasematch
限制允许查找主题行包含列表中每个项目的项目

该方法将筛选器应用于
集合,返回新集合,其中包含原始集合中与筛选器匹配的所有项。下面是一个VB.NET示例代码:

Private Sub RestrictUnreadItems(folder As Outlook.MAPIFolder)
    Dim restrictCriteria As String = "[UnRead] = true"
    Dim strBuilder As StringBuilder = Nothing
    Dim folderItems As Outlook.Items = Nothing
    Dim resultItems As Outlook.Items = Nothing
    Dim mail As Outlook._MailItem = Nothing
    Dim counter As Integer = 0
    Dim item As Object = Nothing
    Try
        strBuilder = New StringBuilder()
        folderItems = folder.Items
        resultItems = folderItems.Restrict(restrictCriteria)
        item = resultItems.GetFirst()
        While Not IsNothing(item)
            If TypeOf (item) Is Outlook._MailItem Then
                counter += 1
                mail = item
                strBuilder.AppendLine("#" + counter.ToString() + _
                                     " - Subject: " + mail.Subject)
            End If
            Marshal.ReleaseComObject(item)
            item = resultItems.GetNext()
        End While
        If (strBuilder.Length > 0) Then
            Debug.WriteLine(strBuilder.ToString())
        Else
            Debug.WriteLine("There is no match in the " _
                               + folder.Name + " folder.")
        End If
    Catch ex As Exception
        System.Windows.Forms.MessageBox.Show(ex.Message)
    Finally
        If Not IsNothing(folderItems) Then Marshal.ReleaseComObject(folderItems)
        If Not IsNothing(resultItems) Then Marshal.ReleaseComObject(resultItems)
    End Try
End Sub
有关更多信息,请参阅

因此,基本上您的VBA代码应该如下所示:

Dim unreadItems as Outlook.Items
Set unreadItems = myitems.Restrict("[Unread] = true")

For Each myitem In unreadItems
   If myitem.Class = olMail Then

     If InStr(1, myitem.Subject, "Tuf" & "Picking List") > 0 Or _
        InStr(1, myitem.Subject, "TUF" & "PICKING LIST") > 0 Or _
        InStr(1, myitem.Subject, "Tuf" & "Picking List:") > 0 Or _
        InStr(1, myitem.Subject, "tuf" & "picking list") > 0 Then
                Debug.Print "Found a Tufnels Picking List"
                    Found = True
                        If Found = True Then

                        End If
      End If
   End If
Next

这里的
&
运算符将两个字符串连接起来
“Tuf”
“领料单”
。您需要使用逻辑
来连接多个
IF
条件。此外,您应该提前清理大小写,这样您就不需要尝试硬编码所有可能的拼写/大小写排列

更改此项:

If InStr(1, myitem.Subject, "Tuf" & "Picking List") > 0 Or _
    InStr(1, myitem.Subject, "TUF" & "PICKING LIST") > 0 Or _
    InStr(1, myitem.Subject, "Tuf" & "Picking List:") > 0 Or _
    InStr(1, myitem.Subject, "tuf" & "picking list") > 0 Then
            Debug.Print "Found a Tufnels Picking List"
                Found = True
                    If Found = True Then

                    End If
End If
为此:

Dim subj as String
subj = UCase(myItem.Subject) ' ignore casing
Found = (Instr(1, subj, "TUF") > 0) AND (Instr(1, subj, "PICKING LIST") > 0) 
If Found Then
    Debug.Print "Found a Tufnels Picking List"

End If

在这里,我们将主题转换为全大写字符串,这允许我们对大写“TUF”和大写“PICKING LIST”进行单个比较,而不是试图解释这两个子字符串的每种大小写变化。我们没有实际操作
myItem.Subject
——它仍然保留原来的大小写。

提示:这里的
&
操作符连接两个字符串
“Tuf”
“领料单”
。您需要使用逻辑
来连接多个
IF
条件。此外,您应该提前清理大小写,这样您就不需要尝试对所有可能的拼写/大写排列进行硬编码。每次在
For each
循环中运行
Restrict
。您必须将其从循环之外提取。您需要使用
ci_phrasematch
限制。这是非常接近VBA的VB.NET示例。感谢您的回复,一旦我复习了simliar踏板,肯定会在这里完成我的家庭作业。似乎有几种不同的方法来解决这个问题。一些人比其他人参与的更多。谢谢大卫,我目前正在调查此事。我刚开始写剧本,我会研究你的建议。然后回来报到。干杯
InStr
绝对不是一个解决方案。你是说它不适用于这种情况吗?或者你只是喜欢一个不同的实现?我总是建议一个更好的解决方案。Outlook为此提供了更好的工具。这很好,但认为
InStr
绝对不是解决方案是不正确的。这是一个解决方案,它确实有效,它返回正确/预期的结果。这可能不是唯一或最好的解决方案,但绝对是一个解决方案。