Paste clipboard in outlook email in normal order

Question

I have 5 userforms for an email. The workflow goes like this:

create new email

userform1.show
user selects the fields
automatic printscreen is inserted in the text

userform2.show
user selects the fields
automatic printscreen is inserted in the text

userform3.show
user selects the fields
automatic printscreen is inserted in the text

userform4.show
user selects the fields
automatic printscreen is inserted in the text

userform5.show
user selects the fields
automatic printscreen is inserted in the text

My problem is that in the end, the email will look like this:

userform1 selected fields
userform2 selected fields
userform3 selected fields
userform4 selected fields
userform5 selected fields

print screen 5
print screen 4
print screen 3
print screen 2
print screen 1

Is there a way to make the print screens appear in the correct order?

Here is the code that copies the clipboard for the first userform ( the print screen is from another application )

Dim olInsp As Object
Dim oRng As Object
Dim wdDoc As Object

With objItem

         Set olInsp = .GetInspector
         Set wdDoc = olInsp.WordEditor
         Set oRng = wdDoc.Range
         oRng.collapse 1
         objItem.Display
         objItem.Visible = True
         objItem.HtmlBody = "<br><br>" & objItem.HtmlBody

         On Error Resume Next
         oRng.Paste

         objItem.HtmlBody = "<br>" & objItem.HtmlBody

         Dim myOutlook As Object
         Set myOutlook = GetObject(, "Outlook.Application")
         myOutlook.ActiveExplorer.Activate

End With

I made the cursor to move to the end of the mail but the paste doesn't work at all

Dim objCurrentMail As Outlook.MailItem
Dim objWordDocument As Word.Document
Dim objWordRange As Word.Range
Dim VarPosition As Variant

    'Only work if the current email is using word editor
    Set objCurrentMail = Outlook.Application.ActiveInspector.CurrentItem
    Set objWordDocument = objCurrentMail.GetInspector.WordEditor


       VarPosition = objWordDocument.Range.End - 1000
       Set objWordRange = objWordDocument.Range(VarPosition, VarPosition)
       objWordRange.Select

    keybd_event VK_DOWN, 0, 0, 0
    keybd_event VK_DOWN, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_CONTROL, 0, 0, 0
    keybd_event VK_V, 0, 0, 0
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0

Answer 1

There is code here to move the cursor to the end http://www.vboffice.net/en/developers/determine-cursor-position/

Public Sub SetCursor()
    Dim Ins As Outlook.Inspector
    Dim Doc As Word.Document
    Dim range As Word.range
    Dim pos As Long

    Set Ins = Application.ActiveInspector
    Set Doc = Ins.WordEditor
    If Not Doc Is Nothing Then
        pos = Doc.range.End - 1
        Set range = Doc.range(pos, pos)
        range.Select
    End If
End Sub

Your code could look like this:

Option Explicit

Sub pasteAtEnd()

Dim olInsp As Object
Dim oRng As Object
Dim wdDoc As Object

Dim pos As Long
Dim objItem As Object

Set objItem = ActiveInspector.currentItem

With objItem

    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.range

    objItem.Display
    'objItem.HTMLBody = "<br><br>" & objItem.HTMLBody
    objItem.HTMLBody = objItem.HTMLBody & "<br><br>"

    pos = wdDoc.range.End - 1
    Set oRng = wdDoc.range(pos, pos)
    oRng.Select

    MsgBox "Cursor should be at end of the mail body."

    'On Error Resume Next ' Use proper error handling
    oRng.Paste

End With

End Sub

Answer 2

please try this

if that does not work, click on the email window and hit ctrl-v to paste the content of the clipboard

Sub testPaste()

    Dim outMail As Outlook.MailItem
    Set outMail = Application.CreateItem(olMailItem)
    outMail.Display (False)                      ' modeless

    Dim wd As Document
    Set wd = outMail.GetInspector.WordEditor

    WordBasic.SendKeys "{prtsc}"   ' do screenshot  may or may not work on your pc
    wd.Range.Paste                 ' paste from clipboard

    Set wd = Nothing
    Set outMail = Nothing
End Sub