VBA如何在正文粘贴EXCEL内容

haiyinsha

各位大侠:

        本人想实现自动发送mail,目前遇到一麻烦,就是把excel内容copy图片格式后,如何才能自动粘贴到正文中!

 希望有高手给予解答.非常感谢!

                            

                      Body属性!我只会写入相关内容   如: .Body="1213213"

                                                                          望大侠出手!!!

Sub SENDMAIL()
Dim pic As Shapes
 Sheet1.Range("A1:H18").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Dim olkapp As Object
Dim malinewmail As Object
Dim myAttachments As Object
Set olkapp = CreateObject("outlook.application")
Set oItem = olkapp.CreateItem(olMailItem)
Set myAttachments = oItem.Attachments
  With oItem
   .To = "INVENTYR_1"
   .Subject = "test"
   .Body = "test!" & past
   .CC = "   "
   .Importance = olImportanceLow
   .NoAging = True
   .Display
 End With
  myAttachments.Add "D:\2008.xls", _
        olByValue, 1, "Test"
  Application.OnTime Now + TimeValue("00:00:05"), "hdh"

End Sub

Sub hdh()
SendKeys "%s"
End Sub

haiyinsha

请高手,出动!!!

haiyinsha

主要是不像excel可以录制宏,可以自己摸索.希望有人指教！

haiyinsha

大哥们给点提示！！！！！！！！！！！！！！！！！！！！！

haiyinsha

这个版块太冷场！！！[em14]

风吹过的地方

粘贴EXCEL内容

BobPan

可以先将Excel文件另存为网页，读取代码，然后再利用.HTMLBody设置代码即可！

更多请参考：http://www.rondebruin.nl/sendmail.htm

 

WBwRVGO1.rar (18.88 KB, 下载次数: 904)

2008-2-25 17:49 上传

点击文件名下载附件
VBA如何在正文粘贴EXCEL内容

aaaaabbbbb

请学习本版置顶的VBA集中营一贴，试着修改你的代码。下面的帖子应该会让你有点启示。

http://club.excelhome.net/viewthread.php?tid=123820&replyID=&skin=0

请动手修改一下，有问题再大家一起讨论。

haiyinsha

非常感谢:BobPan 及 版主

    我试用你的方法,可是发现有个问题.

    我的excel内带有图表及图片,BODY内发现没有图表及图片.

请问高手有没有更好的办法,解决!

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    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

tinus

QUOTE:

以下是引用haiyinsha在2008-2-19 15:33:14的发言：

各位大侠:

        本人想实现自动发送mail,目前遇到一麻烦,就是把excel内容copy图片格式后,如何才能自动粘贴到正文中!

 希望有高手给予解答.非常感谢!

                            

                      Body属性!我只会写入相关内容   如: .Body="1213213"

                                                                          望大侠出手!!!

Sub SENDMAIL()
Dim pic As Shapes
 Sheet1.Range("A1:H18").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Dim olkapp As Object
Dim malinewmail As Object
Dim myAttachments As Object
Set olkapp = CreateObject("outlook.application")
Set oItem = olkapp.CreateItem(olMailItem)
Set myAttachments = oItem.Attachments
  With oItem
   .To = "INVENTYR_1"
   .Subject = "test"
   .Body = "test!" & past
   .CC = "   "
   .Importance = olImportanceLow
   .NoAging = True
   .Display
 End With
  myAttachments.Add "D:\2008.xls", _
        olByValue, 1, "Test"
  Application.OnTime Now + TimeValue("00:00:05"), "hdh"

End Sub

Sub hdh()
SendKeys "%s"
End Sub

sendkeys "^v"    'or sendkeys "%ep"

Application.OnTime Now + TimeValue("00:00:05"), "hdh"