Paste clipboard into Outlook email normally
I have 5 custom email forms. The workflow looks 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 at the end of the email it 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 for the print screens to appear in the correct order?
Here is the code that copies the clipboard for the first custom form (print screen 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 move to the end of the post, 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
+3
source to share
4 answers
There is code here to move 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 might look like:
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
+3
source to share
try it
this is a "proof of concept" kind
Hope this works for you.
there is a place in "addTextToMessage" where the program stops,
and take a screenshot then press F5 to continue
the program also inserts the image from the folder if you need (set the path according to your system)
Const uf1 = "userform1 selected fields" ' sample userform text
Const uf2 = "userform2 selected fields"
Const uf3 = "userform3 selected fields"
Const uf4 = "userform4 selected fields"
Const uf5 = "userform5 selected fields"
Sub fillEmail()
Dim outMail As Outlook.MailItem
Set outMail = Application.CreateItem(olMailItem)
outMail.To = "example@example.com"
outMail.Subject = "Testing inline images"
outMail.Display (False) ' modeless
Dim wordDoc As Document
Set wordDoc = Application.ActiveInspector.WordEditor
Set wordDoc = outMail.GetInspector.WordEditor
wordDoc.Paragraphs.Space1 ' format paragraph
wordDoc.Paragraphs.SpaceBefore = 0 ' single-spaced ... etc
wordDoc.Paragraphs.SpaceAfter = 0
addTextToMessage wordDoc, uf1 ' these simulate the
addTextToMessage wordDoc, uf2 ' five userforms boxes
addTextToMessage wordDoc, uf3 ' you could pass the wordDoc reference
addTextToMessage wordDoc, uf4 ' to each userform and have the userform
addTextToMessage wordDoc, uf5 ' call the "addTextToMessage"
Set wordDoc = Nothing
Set outMail = Nothing
End Sub
Sub addTextToMessage(wd As Document, uf As String)
' Debug.Print "------------------------------------------------"
' Debug.Print " uf : " & uf
' Debug.Print "wd.Paragraphs.Count : " & wd.Paragraphs.Count
' Debug.Print " wd.Sentences.Count : " & wd.Sentences.Count
' Debug.Print "wd.Characters.Count : " & wd.Characters.Count
' Debug.Print " wd.Range.End : " & wd.Range.End
' Debug.Print "------------------------------------------------"
wd.Range.InsertAfter (uf)
wd.Range.InsertParagraphAfter
wd.Range.InsertParagraphAfter
wd.Range.InsertParagraphAfter
Stop
' ------------------------------
' do screenshot here then hit F5
' ------------------------------
wd.Characters.Last.Paste
wd.Range.InsertParagraphAfter
' this inserts a picture from folder
' the userforms could place pictures in a folder
wd.Characters.Last.InlineShapes.AddPicture _
FileName:="C:\Users\js\AppData\Local\Temp\picture.png", _
LinkToFile:=False, SaveWithDocument:=True
wd.Range.InsertParagraphAfter
' Debug.Print "wd.Paragraphs.Count : " & wd.Paragraphs.Count
' Debug.Print " wd.Sentences.Count : " & wd.Sentences.Count
' Debug.Print " wd.Range.End : " & wd.Range.End
End Sub
0
source to share
code updated here
create a custom form with five buttons
paste this into your form code
it represents the five custom shapes you mentioned
you can click the buttons in any order, but the resulting email is always in the sequence
NOTE: take a screenshot or copy the graphics to the clipboard before clicking the buttons
' test userForm code
Private Sub CommandButton1_Click()
' extra "demo" code in this sub
' see CommandButton2_Click sub for simplest code needed
Dim rng As word.Range
Set rng = emailTables(1).Cell(1, 1).Range
' rng.Select ' debug
rng.InsertAfter "1st line of response from userForm #1" & vbCrLf
rng.InsertAfter "2nd line of response from userForm #1" & vbCrLf
Set rng = emailTables(2).Cell(1, 1).Range
' rng.Select ' debug
rng.InsertAfter "screenshot from" & vbCrLf
rng.InsertAfter "userForm #1" & vbCrLf
rng.InsertAfter vbCrLf & vbCrLf
' rng.Words(rng.Words.Count).Select ' debug
' rng.Words(rng.Words.Count - 1).Select ' debug
rng.Words(rng.Words.Count - 1).Paste ' paste screenshot
' insert picture from disk
' emailTables(2).Cell(1, 1).Range.InlineShapes.AddPicture FileName:="C:\Users\js135001\AppData\Local\Temp\F4C97A0.png", LinkToFile:=False, SaveWithDocument:=True
Set rng = Nothing
End Sub
'
Private Sub CommandButton2_Click()
emailTables(1).Cell(2, 1).Range.InsertAfter "response from userForm #2"
emailTables(2).Cell(2, 1).Range.Paste ' paste screenshot
End Sub
'
Private Sub CommandButton3_Click()
emailTables(1).Cell(3, 1).Range.InsertAfter "response from userForm #3"
emailTables(2).Cell(3, 1).Range.Paste ' paste screenshot
End Sub
'
Private Sub CommandButton4_Click()
emailTables(1).Cell(4, 1).Range.InsertAfter "response from userForm #4"
emailTables(2).Cell(4, 1).Range.Paste ' paste screenshot
End Sub
'
Private Sub CommandButton5_Click()
emailTables(1).Cell(5, 1).Range.InsertAfter "response from userForm #5"
emailTables(2).Cell(5, 1).Range.Paste ' paste screenshot
End Sub
'
Private Sub UserForm_Initialize()
UserForm1.Caption = "do a screenshot before clicking buttons"
CommandButton1.Caption = "UserForm1 response"
CommandButton2.Caption = "UserForm2 response"
CommandButton3.Caption = "UserForm3 response"
CommandButton4.Caption = "UserForm4 response"
CommandButton5.Caption = "UserForm5 response"
End Sub
put this code in a module and run it
' main code
Public emailTables As word.Tables ' parameter passing to UserForms
'
Sub testEmail() ' run me
Dim outMail As Outlook.MailItem
Set outMail = Application.CreateItem(olMailItem)
outMail.Display (False) ' modeless
Dim wd As Document
Set wd = outMail.GetInspector.WordEditor
For i = 0 To 9 ' anchors for placing the two tables
wd.Range.InsertAfter vbCrLf
Next
' at this point, here is what the document contains:
' 1 Section / 11 Paragraphs / 1 Sentence / 11 Words / 11 Characters
' replace 4th character with a table ... same with 8th character
' place 2nd table first, because the 8th character would fall in the middle of the first table (if the 1st table was placed first)
wd.Tables.Add Range:=wd.Characters(8), NumRows:=5, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
wd.Tables.Add Range:=wd.Characters(4), NumRows:=5, NumColumns:=1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
MsgBox "please acquire a screenshot before clicking any of the buttons"
Set emailTables = wd.Tables
UserForm1.Show
Set wd = Nothing
Set outMail = Nothing
End Sub
enjoy
0
source to share
try it
if that doesn't work click on the email window and press ctrl-v to paste the contents 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
0
source to share