Copy and Paste Into Outlook

[DFeeney]

Hi All

I'm trying to get Word to copy and paste the contents of a word document into a new outlook message and I can get it to work sometimes but other times I get the error:


Run-Time error '4605'
Method PasteAndFormat of object 'Selection' failed.


This is the script I use to do this. I can see it makes its way to the clipboard, but won't paste the rest of the way.



Sub EmailData()

'Sets document up as an email



Dim OutApp As Object
Dim OutMail As Object
Dim OutInsp As Outlook.Inspector
Dim WdApp As Word.Application
Dim OutDoc As Word.Document
Dim WdSel As Word.Selection

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.Subject = "Please Approve"
.Display
End With

Set OutInsp = OutMail.GetInspector
Set OutDoc = OutInsp.WordEditor
Set WdApp = OutDoc.Application
Set WdSel = WdApp.Selection


ActiveDocument.Range.Copy

With OutMail
WdSel.PasteAndFormat Type:=wdFormatOriginalFormatting
End With

Set WdSel = Nothing
Set OutInsp = Nothing
Set OutMail = Nothing
Set OutDoc = Nothing
Set WdApp = Nothing
Set OutApp = Nothing

End Sub



Thanks,

Dallas

[gmaxey]

I'm not very savvy with OUTLOOK but perhaps:

Sub EmailData()
Dim oOLApp As Object
Dim oMsg As Object
Dim oInsp As Object
Dim oDoc As Object
  Set oOLApp = CreateObject("Outlook.Application")
  Set oMsg = oOLApp.CreateItem(0)
  With oMsg
    .To = ""
    .Subject = "Please Approve"
    Set oInsp = .GetInspector
    Set oDoc = oInsp.WordEditor
    ActiveDocument.Range.Copy
    oDoc.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
    .Display
  End With
  Set oInsp = Nothing
  Set oMsg = Nothing
  Set oDoc = Nothing
  Set oOLApp = Nothing
End Sub

[gmayor]

If you are going to use the Outlook Word Editor Inspector to process the message, then you should be aware that creating an Outlook Object doesn't work reliably. You should instead use the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm (it's the section under Test the Code) to start Outlook. You can then use

Sub Send_As_HTML_EMail()
'Graham Mayor - http://www.gmayor.com - Last updated - 14 Jul 2017
'Requires the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim objdoc As Object
Dim objSel As Selection
    On Error Resume Next
    ActiveDocument.Range.Copy
    Set olApp = OutlookApp()
    Set oItem = olApp.CreateItem(0)
    With oItem
        .BodyFormat = 2
        .Display
        Set objdoc = .GetInspector.WordEditor
        Set objSel = objdoc.Windows(1).Selection
        objSel.PasteAndFormat Type:=wdFormatOriginalFormatting
        .to = ""
        .Subject = "Please approve"
    End With
lbl_Exit:
    Set oItem = Nothing
    Set olApp = Nothing
    Set objdoc = Nothing
    Set objSel = Nothing
    Exit Sub
End Sub

[DFeeney]

Thanks Graham,

This seems to work really well. Any advice on how to stop the following prompt from appearing?
Capture.JPG

[gmayor]

This relates to your AV software. From Outlook go to File > Options > Trust Center > Trust Center Settings > Programmatic Access.

At the bottom of this dialog, note what your "Antivirus status" is. If it is "Invalid" then close Outlook.

Right-click Outlook Start Menu icon and select More > "Run as administrator" from the pop-up-menu. If you get a warning, then select "allow" or "yes" to continue.

Go back to Programmatic Access as described above, and you should see your antivirus status updated to "Valid" (assuming Windows Defender is running, or you have another up-to-date antivirus program on your computer).

Close and re-open Outlook normally