Need help taking a string from body of a selected eamil and add it to subject.

[Ellioutt]

Hi, new forum member here.


I have some experience writing scripts in VBA but never in Outlook. We use a shipping company that send us a ref number in the body rather that the subject of an email. As they are un-willing to change their format we need a work-around to do this for us. The end user wants a "button" in Outlook that will move the ref number to the subject. The ref number is always in the following format:


"Cust. Ref: 00000" (without quotes and the 0's would be random numbers).


I have RegEx enabled as I guess I will need that. Apart from that I have tried looking for some basic code to get me started but haven’t had much luck, so I’m starting with nothing here… No sample code.
I know it is possible to change the subject on all emails in a folder as I’ve seen code for that and I have seen code for finding a string in the email body.
If possible we would also like the ability to select multiple emails to run this script on.

Thanks in advance


Elliott

[gmayor]

Maybe as follows

Sub MoveRefNum()
Dim oItem As MailItem
Dim oDoc As Object
Dim oRng As Object
Dim i As Long
    'Open Quick Turnaround email template
    For i = 1 To ActiveExplorer.Selection.Count
        Set oItem = ActiveExplorer.Selection(i)
        Set oDoc = oItem.GetInspector.WordEditor
        oItem.Display
        Set oRng = oDoc.Range
        With oRng.Find
            Do While .Execute("Cust. Ref: ")
                oRng.collapse 0 'omit this line if you need to add the Cust. Ref text to the subject as well as the number.
                oRng.moveendwhile "0123456789"
                oItem.Subject = oRng.Text & Chr(32) & oItem.Subject
                Exit Do
            Loop
        End With
        oItem.Close olSave
    Next i
lbl_Exit:
    Set oItem = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

[Ellioutt]

Maybe as follows

Sub MoveRefNum()
Dim oItem As MailItem
Dim oDoc As Object
Dim oRng As Object
Dim i As Long
    'Open Quick Turnaround email template
    For i = 1 To ActiveExplorer.Selection.Count
        Set oItem = ActiveExplorer.Selection(i)
        Set oDoc = oItem.GetInspector.WordEditor
        oItem.Display
        Set oRng = oDoc.Range
        With oRng.Find
            Do While .Execute("Cust. Ref: ")
                oRng.collapse 0 'omit this line if you need to add the Cust. Ref text to the subject as well as the number.
                oRng.moveendwhile "0123456789"
                oItem.Subject = oRng.Text & Chr(32) & oItem.Subject
                Exit Do
            Loop
        End With
        oItem.Close olSave
    Next i
lbl_Exit:
    Set oItem = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Thanks, that worked a treat.