Excel 범위를 Outlook 전자 메일 본문에 붙여 넣으십시오.

Question

Excel 시트의 고정 범위에서 데이터를 복사하고 전자 메일 본문에 붙여 넣으 려합니다.

다음은 내가 제안한 코드입니다. 그러나 나는 지정된 범위 A11 : H12를 붙일 수 없다.

Private Sub CommandButton1_Click() 
    On Error GoTo ErrHandler 

' SET Outlook APPLICATION OBJECT. 
Dim objOutlook As Object 
Set objOutlook = CreateObject("Outlook.Application") 

' CREATE EMAIL OBJECT. 
Dim objEmail As Object 
Set objEmail = objOutlook.CreateItem(olMailItem) 

With objEmail 
    .To = "email" 
    .Subject = "test" 
    .Body = ActiveSheet.Range("A11:H12").Select 
    .Display  ' DISPLAY MESSAGE. 
End With 

' CLEAR. 
Set objEmail = Nothing: Set objOutlook = Nothing 

ErrHandler: 
    ' 
End Sub 

Answer 1

댓글에서 론이 생각했습니다. 벨로우즈 코드와 함수가 트릭을 수행합니다. 그들에게 모두

Private Sub CommandButton1_Click() 

' SET Outlook APPLICATION OBJECT. 
Dim rng As Range 
Dim objOutlook As Object 
Set objOutlook = CreateObject("Outlook.Application") 

Set rng = Nothing 
On Error Resume Next 
Set rng = ActiveSheet.Range("A11:H12").SpecialCells(xlCellTypeVisible) 
On Error GoTo 0 

' CREATE EMAIL OBJECT. 
Dim objEmail As Object 
Set objEmail = objOutlook.CreateItem(olMailItem) 

With objEmail 
.To = "email" 
.Subject = "test" 
.HTMLBody = RangetoHTML(rng) 
.Display  ' DISPLAY MESSAGE. 
End With 

' CLEAR. 
Set objEmail = Nothing: 
Set objOutlook = Nothing 

End Sub 

---

Function RangetoHTML(rng As Range) 
' Changed by Ron de Bruin 28-Oct-2006 
' Working in Office 2000-2016 
Dim fso As Object 
Dim ts As Object 
Dim TempFile As String 
Dim TempWB As Workbook 

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

'Copy the range and create a new workbook to past the data in 
rng.Copy 
Set TempWB = Workbooks.Add(1) 
With TempWB.Sheets(1) 
    .Cells(1).PasteSpecial Paste:=8 
    .Cells(1).PasteSpecial xlPasteValues, , False, False 
    .Cells(1).PasteSpecial xlPasteFormats, , False, False 
    .Cells(1).Select 
    Application.CutCopyMode = False 
    On Error Resume Next 
    .DrawingObjects.Visible = True 
    .DrawingObjects.Delete 
    On Error GoTo 0 
End With 

'Publish the sheet to a htm file 
With TempWB.PublishObjects.Add(_ 
    SourceType:=xlSourceRange, _ 
    Filename:=TempFile, _ 
    Sheet:=TempWB.Sheets(1).Name, _ 
    Source:=TempWB.Sheets(1).UsedRange.Address, _ 
    HtmlType:=xlHtmlStatic) 
    .Publish (True) 
End With 

'Read all data from the htm file into RangetoHTML 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 
RangetoHTML = ts.readall 
ts.Close 
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ 
         "align=left x:publishsource=") 

'Close TempWB 
TempWB.Close savechanges:=False 

'Delete the htm file we used in this function 
Kill TempFile 

Set ts = Nothing 
Set fso = Nothing 
Set TempWB = Nothing 
End Function 

Answer 2

코드 복사 :이 목적을 위해

Sub sendEmail() 
    'call outlook 
    Dim MyOlapp As Object, MyItem As Object 
    Set MyOlapp = CreateObject("Outlook.Application") 
    Set MyItem = MyOlapp.CreateItem(olMailItem) 
     'ajust range of sheet 
     Range("A11:H12").Select 
     Selection.Copy 

    With MyItem 
     'ajust number of sheet 
     .To = Sheet17.[b1].Value 'e-mail adress 
     .Subject = Sheet17.[b2].Value 'subject of e-mail 
     .Body = Sheet17.[b3].Value 'body of e-mail 
     .Display 
     SendKeys ("^{DOWN}") 
     SendKeys ("^{DOWN}") 
     SendKeys ("%m") 
     SendKeys ("v") 
     SendKeys ("s") 
     SendKeys ("{UP}") 
     SendKeys ("{UP}") 
     SendKeys ("{ENTER}") 
     SendKeys ("{ENTER}") 
     SendKeys ("%m") 
     SendKeys ("q") 
     SendKeys ("{ENTER}") 


    End With 
    End Sub