Bdtjtk

I get assignments in emails that come to a shared Outlook mailbox.

In a typical email there are multiple strings and variables regarding a client, including their name, date and ID with a hyphen that I also want to get rid of.

There are two types of IDs. Both consist of 8 numbers and a hyphen, e.g. 1234567-8 and 123456-78. Sometimes there is a character in front of the number so I believe storing data in string is a must. I want to make several copies of the macro for each type of data. I want it all in a simple string form as I want to copy it to clipboard and paste elsewhere and have no need to process it further.

The code below does all I want except it stores the data in variables instead of string and does not remove the hyphen.

Code courtesy of 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

I want to search the currently previewed email (if that is possible), without actually opening it in another separate window, for a phrase like

"Customer ID:           123456-78"

and reformat the last part by simply removing the hyphen and disregarding the first part

"Customer ID:           " 

(there is a giant space between the Customer ID and the number).

I also want to reformat the date from 11.22.2019 to 2019-22-11 and also copy it to clipboard.

Searches based on wildcards are limited to what wildcards can provide, which is better than nothing, but still not very much.

Outlook uses Word functions for this, so that the VBA documentation for Word applies. Applicable wildcards themselves are can be seen using the "Special" button in the "Find" dialog (F4 in Outlook), after "use wildcards" has been checked.

To my knowledge there is no concept of "optional" parts in wildcard searches, which means you need to try more than one wildcard pattern to cover your "sometimes there is a letter in front" case.

So the general approach, based this knowledge and on your sample code, would be

• Pick the currently selected MailItem in the ActiveExplorer
  


• For each predefined wildcard pattern
  
  
  
  
  • reset the search range to the whole email
  
  
  • execute wildcard search
  
  
  • as long as there are search hits
    
    
    
    
    • display result, let user pick or cancel the search
    
    
    
    
  
  
  
  

This way multiple patterns can be defined and you have a chance to continue to the next hit if the first hit is a false positive.

I found the pattern [0-9-]{8;9} plus MatchWholeWord to work reasonably well (blocks of digits and dashes, between 8 or 9 characters long), but real life data often has surprises. You will probably need to add more patterns. Watch out: for me, Outlook wants ; instead of ,. This might be dependent on the system locale, I'm not sure.

Also I'm not a fan of a "silent" On Error Resume. If there is an error, I prefer to see an error actual message. If there is a condition that can be checked in order to prevent an error, I prefer to check for this condition explicitly. This makes the code more robust and debugging easier. My Sub does not contain an On Error line for that reason.

In code, this would look like this:

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

Setting variables to Nothing at the end of the function is superfluous.