Select Text Within Email Message Body

[bpoel]

Hello, I've done lots of searching online on this and haven't found a single similar post.

I have an Outlook macro that adds tomorrow's date for me at the push of a button. I want to modify the macro to check if a date was previously inserted, and if so adjust that date forward 1 day. I can write the logic that will check the date, but I'm at a complete blank of how to highlight (select) the text adjacent to my cursor (I don't want to have to highlight it manually). My current macro is below. All I want is the line(s) of code that essentially does the same as a Ctrl + Shift + Left Arrow Key (repeated 5 times). I can handle the rest of the logic from there.


Sub TimeStamp_PlusOne()
If TypeName(ActiveWindow) = "Inspector" Then
If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
'want code to select text left of current cursor position
if SelectedText = tomorrow's date, then
'code to replace text with day after tomorrow's date (I can write this part)
else
ActiveInspector.WordEditor.Application.Selection.TypeText Format(Date + 1, "mmm d (ddd)")
End If
End If
End If
End Sub

[gmayor]

The following will check a date in a message body that the cursor is either in, or immediately to the left or right of (without a space), and will change the date if necessary to tomorrows date (here using the short date format - change the format as required).


Sub CheckDate()'Graham Mayor - http://www.gmayor.com - Last updated - 26/11/2016
Dim oRng As Object
On Error GoTo ErrHandler
If TypeName(ActiveWindow) = "Inspector" Then
If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
Set oRng = ActiveInspector.WordEditor.Application.Selection.Range
oRng.movestartuntil Chr(32), -1073741823
oRng.moveenduntil Chr(32) & Chr(13) & Chr(11) & "!:;?,."
MsgBox oRng.Text
If IsDate(oRng.Text) Then
If Not CDate(Date) = Date + 1 Then
oRng.Text = Format(Date + 1, "Short Date")
End If
End If
MsgBox oRng.Text
End If
End If
lbl_Exit:
Exit Sub
ErrHandler:
Beep
Resume lbl_Exit
End Sub