Question

dim objoutlook as object
dim objmail as object
dim rngto as range
dim rngsubject as range
dim rngbody1 as range
set dodata1 = new dataobject

set objoutlook = createobject ("outlook.application")
set objmail = objoutlook.createitem(0)

with activesheet
    set rngto = .range("iv8")
    set rngsubject = .range ("iv9")
    set rngbody1 = .range(.range("a4:i8"), .range("a4").end(xldown))
    rngbody1.copy
    dodata1.getfromclipboard
end with

with objmail
    .to = rngto.value
    .subject = rngsubject.value
    application.sendkeys ("{tab}")
    doevents

    application.sendkeys "(%{1068})"
    doevents

    .display
end with

sendkeys "^({v})", true

with objoutlook = nothing
with objmail = nothing
with rngto = nothing
with rngsubject = nothing
with rngbody1 = nothing

代码将Excel单元格粘贴到Outlook电子邮件中。在将数据从Excel粘贴到Outlook后，我还想添加屏幕截图。我已经使用sendkeys进行了尝试，但这会将屏幕截图贴在之前的Excel数据上。

任何人都可以建议在电子邮件正文下方添加屏幕截图。

Answer 1

在Excel 2010中测试的代码

Private Sub PasteAtEnd()

'Set reference to Outlook in Tools | References
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem   
Dim myInspector As Outlook.Inspector

'Set reference to Word in Tools | References
Dim myDoc As Word.Document

On Error Resume Next
Set objOutlook = GetObject(, "outlook.application")
On Error GoTo 0

If objOutlook Is Nothing Then
    Set objOutlook = CreateObject("outlook.application")
    Set objMail = objOutlook.CreateItem(0)
    objMail.Display
End If

' If outlook is already open,
'  open a mailitem before running the code
Set myInspector = ActiveInspector.CurrentItem.GetInspector

' This line generates a warning message
Set myDoc = myInspector.WordEditor

' This simulates existing text
myDoc.Content.InsertAfter Chr(13) & "Paste Clipboard after all existing Content" & Chr(13)

' new line
myDoc.Content.InsertAfter Chr(13)

myDoc.Characters.last.Select
myDoc.Application.Selection.Paste

Set myInspector = Nothing
Set myDoc = Nothing
Set objOutlook = Nothing

End Sub

如何在outlook电子邮件的文本正文后添加屏幕截图

1 个答案: