Paste Excel content into body of Outlook mail

[Aschrum]

Hi folks,

I want to select some cells of a worksheet under specific conditions, do addition and paste it into an email.

My current issue is to paste the Excel content into the body.

What I've got in this regard is the following.


Dim xl As Object
Set xl = CreateObject("Excel.Application")

With xl
.Workbooks.Open ("C:\[...]\abc.xls")
.DisplayAlerts = False
.Visible = True
.Range("K16:K17").Select 'Test Range
.Selection.Copy
End With 'No issues till this point

With itm
.To = "a@b.c"
.Subject = "TEST"
.Body = "Guten Morgen," _
& vbCrLf & xl.Selection.Paste 'The mailitem works, the pasting doesn't
.Display
End With


Another snippet I've tried.


Dim xl As Object
Set xl = CreateObject("Excel.Application")
Dim rng As VariantDim cl As Variant
Dim ws As Variant 'As Worksheet not possible in Outlook?

With xl
.Workbooks.Open ("C:\[...]\abc.xls")
.DisplayAlerts = False
.Visible = True
Set ws = ActiveSheet
rng = .Range("K16:K17"). 'Select 'Test Range
'.Selection.Copy
'.Selection.Paste

With rng
.Parent.Select
Set cl = ActiveCell
.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = "Hallo" 'This line doesn't take any effect
With itm
.To = "a@b.c"
.Subject = "TEST"
.Send
End With
End With
End With
End With


Thanks in advance for any suggestions.

André

[mrojas]

In your first chunk of code, as a test, have you tried the following:
With itm
.To = "a@b.c"
.Subject = "TEST"
.Body = xl.Selection.Paste
.Display
End With
I'm not sure if this will work, but it might be worth your while. In the second snippet, in the With .Parent.MailEnvelop block of code, below the .Subject = "TEST" line, add the following two lines:
.Body = "Whatever"
.Paste

[Aschrum]

In both versions I've tried (xl).Selection.Paste, just .Paste, within the body and separately.
Doesn't work. :(

[Aschrum]

Any idea how to refer to the MS Forms Object Library in Outlook?

I've tried it this way, but doesn't work, cause it can't find the library. The path is correct, so it should be about "ReferenceFromFile".


ReferenceFromFile "C:\Windows\system32\FM20.DLL"
Dim myClpObj As DataObject
Set myClpObj = New DataObject
...
With itm
myClpObj.GetFromClipboard
.Body = myClpObj.GetText(1)
...


Edit: Works after adding the following function, but still fails at "DataObject" :/


Function ReferenceFromFile(strFileName As String) As Boolean
Dim ref As Reference

On Error GoTo Error_ReferenceFromFile
References.AddFromFile (strFileName)
ReferenceFromFile = True

Exit_ReferenceFromFile:
Exit Function

Error_ReferenceFromFile:
ReferenceFromFile = False
Resume Exit_ReferenceFromFile

End Function

[Aschrum]

Thanks to the user of another forum I could do it differently. Calculating the sums within Excel instead of selecting, pasting and calculating afterwards.


Dim wb As Variant
Dim ws As Variant
Dim mysum1 As Integer

With xl
Set wb = .Workbooks.Open("C:\[...]\abc.xls")
.DisplayAlerts = False
.Visible = True
Set ws = wb.Sheets(1)
For Each c In ws.Range("C16", ws.Cells(ws.Rows.Count, 3).End(xlup))
If Left(c.Value, 1) = "1" Then
mysum1 = xl.WorksheetFunction.sum(ws.Range("K16:K18"))
...