2015-02-23 1153 views
0
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數據的屏幕截圖。如何在Outlook電子郵件的文本正文後添加屏幕截圖

任何人都可以提出一種方法來添加電子郵件正文下面的截圖。

回答

0

在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 
測試代碼
相關問題