时间戳

首页 > 解决方案 > 如何添加代码以复制 Excel 工作表的第一行并将其粘贴到新的电子邮件正文中

excel - 如何添加代码以复制 Excel 工作表的第一行并将其粘贴到新的电子邮件正文中

问题描述

下面的代码复制我从 Excel 表中选择的选择并将其粘贴到新的电子邮件正文并添加签名，但我还需要将第一行（Range（“A1：O1”））添加到电子邮件正文在它粘贴的选择上方，它将保存范围宽度、高度、格式...

Sub SendSelectedCells_inOutlookEmail()
Dim objSelection As Excel.Range
Dim objTempWorkbook As Excel.Workbook
Dim objTempWorksheet As Excel.Worksheet
Dim strTempHTMLFile As String
Dim objTempHTMLFile As Object
Dim objFileSystem As Object
Dim objTextStream As Object
Dim objOutlookApp As Outlook.Application
Dim objNewEmail As Outlook.MailItem
Dim strSig As String

'Copy the selection
Set objSelection = Selection
Selection.Copy

'Paste the copied selected ranges into a temp worksheet
Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
Set objTempWorksheet = objTempWorkbook.Sheets(1)

'Keep the values, column widths and formats in pasting
With objTempWorksheet.Cells(1)
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteColumnWidths
     .PasteSpecial xlPasteFormats
End With

'Save the temp worksheet as a HTML file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
objTempHTMLFile.Publish (True)

'Create a new email
Set objOutlookApp = CreateObject("Outlook.Application")
Set objNewEmail = objOutlookApp.CreateItem(olMailItem)

'Read the HTML file data and insert into the email body
Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
objNewEmail.Display
strSig = objNewEmail.HTMLBody
objNewEmail.HTMLBody = objTextStream.ReadAll & strSig

'You can specify the new email recipients, subjects here using the following lines:
'objNewEmail.To = "johnsmith@datanumen.com"
'objNewEmail.Subject = "DataNumen Products"
'objNewEmail.Send --> directly send out this email

objTextStream.Close
objTempWorkbook.Close (False)
objFileSystem.DeleteFile (strTempHTMLFile)

结束子

标签： excelvbacopy-paste

解决方案

在复制选择并粘贴到下面之前显式复制标题

Dim dblRH as Double

Set objSelection = Selection
'Copy Headers
dblRH = Rows(1).RowHeight
Range("A1:O1").Copy

'Paste the copied selected ranges into a temp worksheet
Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
Set objTempWorksheet = objTempWorkbook.Sheets(1)

'Keep the values, column widths and formats in pasting
With objTempWorksheet.Cells(1)
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteColumnWidths
     .PasteSpecial xlPasteFormats
     .RowHeight = dblRH
End With

'Copy Selection
objSelection.Copy

With objTempWorksheet.Range("A2")
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteFormats
End With

推荐阅读