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.