PDA

View Full Version : Automated greeting line macro - leave the cursor in the right place?


BeenCounter
10-18-2018, 01:36 AM
Hi Everyone,

With a lot of searching and trial and error and thanks to some very helpful posts on his forum, I have managed to put together a greeting macro for outlook which:

1) works when you click reply or reply all

2) gets the recipient's first name(and works with multiple recipients)

3) pastes it into the email body without breaking my signature

The only annoying thing is it leaves the cursor right at the beginning of the greeting, so the first thing I have to do before I can start typing the email is move the cursor down, which is *annoying*.

What I want is for the cursor to be waiting for me in the email body, two lines down from the greeting:



Hi Bob,

| <-- That's the cursor



Here is the VBA I've been using:


Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
Dim oResponse As MailItem

Private Sub Application_Startup()
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False
End Sub

Private Sub oExpl_SelectionChange()
On Error Resume Next
Set oItem = oExpl.Selection.Item(1)
End Sub

' Reply
Private Sub oItem_Reply(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True

Set oResponse = oItem.Reply
afterReply
End Sub
'Forward:
'Private Sub oItem_Forward(ByVal Response As Object, Cancel As Boolean)
' Cancel = True
' bDiscardEvents = True
'Set oResponse = oItem.Forward
' afterReply
' End Sub
'Reply all:
Private Sub oItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Set oResponse = oItem.ReplyAll
afterReply
End Sub
Private Sub afterReply()
oResponse.Display

Dim Recipients As Outlook.Recipients
Dim i
Dim strGreetName As String
Dim strGreetNameAll As String
Set Recipients = oResponse.Recipients
For i = 1 To Recipients.Count
Debug.Print Recipients(i)

strGreetName = Left(Recipients(i), InStr(1, Recipients(i), " ") - 1)
strGreetNameAll = strGreetNameAll & strGreetName & ", "
Next i
Debug.Print strGreetNameAll
With oResponse
.HTMLBody = "<body>Hi " & strGreetNameAll & vbNewLine & "</br>" & oResponse.HTMLBody
.Display
End With
End Sub


Thanks!
gmayor
10-19-2018, 04:25 AM
You probably need something like the following. You will need to add the reference to olMsg from the calling macros e.g.


afterReply oResponse


Private Sub afterReply(olMsg As Object)
Dim Recipients As Outlook.Recipients
Dim i As Long
Dim strGreetName As String
Dim strGreetNameAll As String
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object

Set Recipients = olMsg.Recipients
For i = 1 To Recipients.Count
Debug.Print Recipients(i)
strGreetName = Left(Recipients(i), InStr(1, Recipients(i), " ") - 1)
strGreetNameAll = strGreetNameAll & strGreetName & ", "
Next i
Debug.Print strGreetNameAll
With olMsg
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
.Display
Set oRng = wdDoc.Range
oRng.collapse 1
oRng.Text = "Hi " & strGreetNameAll & vbNewLine
oRng.collapse 0
oRng.Select
End With
Set olMsg = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub