搜索当前查看的电子邮件中的特定短语,获取字符串以复制到剪贴板

时间:2019-01-03 17:06:01

标签: vba string outlook outlook-vba

我收到来自共享Outlook邮箱的电子邮件中的作业。

在典型的电子邮件中,有多个有关客户的字符串和变量,包括它们的名称,日期和带有连字符的ID,我也想摆脱这些变量。

有两种类型的ID。两者都由8个数字和一个连字符组成,例如1234567-8和123456-78。有时数字前面会有一个字符,因此我认为必须将数据存储在字符串中。我想为每种类型的数据制作宏的多个副本。我希望所有内容都采用简单的字符串形式,因为我想将其复制到剪贴板并粘贴到其他位置,而无需进一步处理。

下面的代码可以满足我的所有需求,除了它将数据存储在变量而不是字符串中并且不会删除连字符。

代码由vbaexpress的gmayor提供。

Option Explicit

Sub GetCustomer()
Dim olItem As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim dCust As DataObject
Dim wdDoc As Object
Dim oRng As Object
Dim sCustomer As String
Dim bFound As Boolean
    On Error GoTo lbl_Exit
    Set olItem = ActiveExplorer.Selection.Item(1)
    With olItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(findText:="Customer #:[ 0-9]{2,}", MatchWildcards:=True)
                sCustomer = Trim(Split(oRng.Text, Chr(58))(1))
                bFound = True
                Set dCust = New DataObject
                dCust.SetText sCustomer
                dCust.PutInClipboard
                MsgBox "Customer number '" & sCustomer & "' copied to clipboard"
                Exit Do
            Loop
        End With
        If Not bFound Then MsgBox "Customer number not found"
    End With
lbl_Exit:
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set dCust = Nothing
    Exit Sub
End Sub

我想搜索当前预览的电子邮件(如果可能的话),而无需在另一个单独的窗口中打开它,例如

"Customer ID:           123456-78"

并通过简单地删除连字符而不考虑第一部分来重新格式化最后一部分

"Customer ID:           " 

(客户ID和号码之间有一个很大的空格)。

我也想将日期从2019年11月22日重新格式化为2019年22月11日,并将其复制到剪贴板中。

1 个答案:

答案 0 :(得分:1)

基于通配符的搜索仅限于通配符可以提供的内容,这总比没有好,但仍然不是很多。

Outlook为此使用了Word函数,因此VBA documentation for Word适用。在选中“使用通配符”之后,可以使用“查找”对话框中的“特殊”按钮(在Outlook中为F4)查看适用的通配符本身。

据我所知,通配符搜索中没有“可选”部分的概念,这意味着您需要尝试多个通配符模式来解决“有时前面有一个字母”的情况。

因此,根据这些知识和您的示例代码,一般的方法将是

  • MailItem中选择当前选择的ActiveExplorer
  • 对于每个预定义的通配符模式
    • 将搜索范围重置为整个电子邮件
    • 执行通配符搜索
    • 只要有搜索结果
      • 显示结果,让用户选择或取消搜索

这样,可以定义多个模式,如果第一个匹配为假阳性,您就有机会继续下一个匹配。

我发现模式[0-9-]{8;9}MatchWholeWord可以很好地工作(数字和破折号,长度在8或9个字符之间),但是现实生活中的数据常常令人惊讶。您可能需要添加更多模式。注意:对我而言,Outlook希望使用;而不是,。我不确定这可能取决于系统区域设置。

我也不喜欢“沉默的” On Error Resume。如果有错误,我希望看到一条错误的实际消息。如果存在可以检查以防止错误的条件,则我希望显式检查此条件。这使代码更健壮,调试也更容易。因此,我的Sub不包含On Error行。

在代码中,如下所示:

Sub GetCustomer()
    Dim olItem As Outlook.MailItem
    Dim oRng As Object
    Dim sCustomer As String
    Dim patterns As Variant, pattern As Variant
    Dim answer As VbMsgBoxResult

    ' bail out if the preconditions are not right
    If ActiveExplorer.Selection.Count = 0 Then Exit Sub
    If Not (TypeOf ActiveExplorer.Selection.item(1) Is MailItem) Then Exit Sub

    Set olItem = ActiveExplorer.Selection.item(1)
    Set oRng = olItem.GetInspector.WordEditor.Range

    ' add more wildcard patterns in descending order of likelyhood
    patterns = Array("[0-9-]{8;9}", "[A-Z][0-9-]{8;9}")

    For Each pattern In patterns
        oRng.WholeStory
        While oRng.Find.Execute(findText:=pattern, MatchWildcards:=True, MatchWholeWord:=True)
            answer = MsgBox(oRng.Text, vbYesNoCancel + vbQuestion, "Customer Number")
            If answer = vbYes Then
              With New DataObject
                  .SetText oRng.Text
                  .PutInClipboard
              End With
              Exit For
            ElseIf answer = vbCancel Then
              Exit For
            End If
        Wend
    Next pattern
End Sub

在函数末尾将变量设置为Nothing是多余的。