2010-09-21 111 views
0

如何使用VBA将一系列单元格从Excel复制到Outlook中的电子邮件正文(而不是将Excel文件作为附件添加)。我只需要将内容作为Outlook邮件的主体。任何人都可以帮助我使用宏编写这个代码吗?从Excel中将单元格的范围复制到Outlook中的电子邮件正文

+0

这回答了这个问题:http://stackoverflow.com/questions/29092999/pasting-an-excel-range-into-an-email-as-a-picture – 2015-03-17 08:11:42

回答

2

你可以在这里找到一个打包的解决方案:http://www.rondebruin.nl/mail/folder1/mail4.htm

Sub Mail_Range() 
'Working in 2000-2010 
    Dim Source As Range 
    Dim Dest As Workbook 
    Dim wb As Workbook 
    Dim TempFilePath As String 
    Dim TempFileName As String 
    Dim FileExtStr As String 
    Dim FileFormatNum As Long 
    Dim I As Long 

    Set Source = Nothing 
    On Error Resume Next 
    Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    If Source Is Nothing Then 
     MsgBox "The source is not a range or the sheet is protected, " & _ 
       "please correct and try again.", vbOKOnly 
     Exit Sub 
    End If 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    Set wb = ActiveWorkbook 
    Set Dest = Workbooks.Add(xlWBATWorksheet) 

    Source.Copy 
    With Dest.Sheets(1) 
     .Cells(1).PasteSpecial Paste:=8 
     .Cells(1).PasteSpecial Paste:=xlPasteValues 
     .Cells(1).PasteSpecial Paste:=xlPasteFormats 
     .Cells(1).Select 
     Application.CutCopyMode = False 
    End With 

    TempFilePath = Environ$("temp") & "\" 
    TempFileName = "Range of " & wb.Name & " " _ 
       & Format(Now, "dd-mmm-yy h-mm-ss") 

    If Val(Application.Version) < 12 Then 
     'You use Excel 2000-2003 
     FileExtStr = ".xls": FileFormatNum = -4143 
    Else 
     'You use Excel 2007-2010 
     FileExtStr = ".xlsx": FileFormatNum = 51 
    End If 

    With Dest 
     .SaveAs TempFilePath & TempFileName & FileExtStr, _ 
       FileFormat:=FileFormatNum 
     On Error Resume Next 
     For I = 1 To 3 
      .SendMail "[email protected]", _ 
         "This is the Subject line" 
      If Err.Number = 0 Then Exit For 
     Next I 
     On Error GoTo 0 
     .Close SaveChanges:=False 
    End With 

    'Delete the file you have send 
    Kill TempFilePath & TempFileName & FileExtStr 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 
End Sub 

问候,

1

here如果它可以帮助你。

我正在寻找解决方案,将多个Excel 2007单元格复制/粘贴到带有VBA的Outlook邮件正文中,但既没有直接复制/粘贴,MsgBody.HTMLBody = Range.Text也没有剪贴板(通过DataObject)工作。 然后,我觉得这个以前的解决方案,它解决了我的问题,希望这也能帮助你:)

干杯!

相关问题