电子邮件正文中间的范围
Posted
技术标签:
【中文标题】电子邮件正文中间的范围【英文标题】：Range in Middle of the email body 【发布时间】：2015-04-02 19:16:42 【问题描述】：我正在编写一个可以在电子邮件正文中间获取范围/选择的代码。下面的代码对我来说工作得很好，它没有在电子邮件正文的中间捕获所需的范围。这将节省我手动工作的时间。
Sub Selection_email()
Dim bStarted As Boolean
Dim olApp As Object: Set olApp = CreateObject("Outlook.Application")
Dim olMailItm As Object: Set olMailItm = olApp.CreateItem(0)
Dim rngTo As Range
Dim rngSubject As Range
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
Set oItem = oOutlookApp.CreateItem(olMailItem)
With Active Sheet
Set rngTo = .Rng("E3")
Last = ActiveSheet.Cells(2, 4).Value
End With
With oItem
.SentOnBehalfOfName = ""
.To = rngTo.Value
.Cc = ""
.Subject = "" & Last & ""
.body = "Hello," & vbNewLine & vbNewLine & _
"Welcome to My World"& vbNewLine & vbNewLine & _
**HERE I NEED THE CODE TO PASTE THE RANGE FROM THE EXCEL FILE IT SHOULD BE FROM "A1:D6"**
"Thank you for your cooperation."
.Display.
If bStarted Then
oOutlookApp.Quit
End If
Set oOutlookApp = Nothing
End Sub
【问题讨论】：
【参考方案1】：Option Explicit
Sub Selection_email()
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Outlook.MailItem
Dim olMailItm As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim Last As Variant
Dim htmlString As String
Dim beginBody, endBody As String
Dim oOutlookApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
Set oItem = oOutlookApp.CreateItem(olMailItem)
With ActiveSheet
Set rngTo = .Range("E3")
Last = ActiveSheet.Cells(2, 4).Value
End With
'create the HTML table first --
' this builds a string with proper HTML header info
htmlString = RangetoHTML(ActiveSheet.Range("A1:D6"))
'now add the email greeting to the body information
beginBody = Left(htmlString, InStr(1, htmlString, "<body>", vbTextCompare) + 6)
endBody = Right(htmlString, Len(htmlString) - InStr(1, htmlString, "<body>", vbTextCompare) + 5)
htmlString = beginBody & _
"Hello,<br><br>Welcome to My World<br><br>" & _
endBody
'now find the end of the table and add the signoff message
beginBody = Left(htmlString, InStr(1, htmlString, "</div>", vbTextCompare) + 6)
endBody = Right(htmlString, Len(htmlString) - InStr(1, htmlString, "</div>", vbTextCompare) + 5)
htmlString = beginBody & _
"<br><br>Thank you for your cooperation." & _
endBody
With oItem
.SentOnBehalfOfName = ""
.To = rngTo.Value
.CC = ""
.Subject = "" & Last & ""
.HTMLBody = htmlString
.Display
End With
If bStarted Then
oOutlookApp.Quit
End If
Set oOutlookApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' By Ron de Bruin.
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
【讨论】：
@Peter：不工作你能不能帮我合并代码，或者说我们能不能有一个代码，它可以选择指定的范围，然后将它粘贴到电子邮件正文之间。 我相信我误解了您要执行的操作（因为我扫描问题的速度太快了）。也许这会有所帮助：Ron de Bruin - Mail Range/Selection in the body of the mail ? 我试过了，也许这没用，因为我有多张纸，我只想告诉你邮件正文中间的那个范围。 所以您想在电子邮件正文中创建一个包含 6 行 4 列的 HTML 表格，以显示来自特定工作表的数据以及来自单元格 A1:D6 的数据？然后可能插入多个 HTML 6x4 表格，其中包含来自多个工作表的数据，每个表格显示范围 A1:D6 的数据？ 我想再次重申。我有一个工作表，其中我有 250 条记录，一个特定的位置很常见，我会将这些位置拆分为多个工作表。现在我想要的是我上面写的代码是正确的，但是当我编写 .body 代码时，我想要在电子邮件正文中间的范围 A1:D6。【参考方案2】：我假设“A1:D6”是一个合并范围。在这种情况下，您只需要左上角的单元格。如果我做了不正确的假设，请告诉我。
.body = "你好," & vbNewLine & vbNewLine & _
“欢迎来到我的世界”& vbNewLine & vbNewLine & _
Activesheet.range("A1").value & _
“感谢您的合作。”用更具体的内容替换 Activesheet 也是一个好主意，但取决于您的工作表。
编辑
使用此处的 RangeToHTML 函数：Paste specific excel range in outlook 然后改变
.body = "Hello," & vbNewLine & vbNewLine & _
"Welcome to My World"& vbNewLine & vbNewLine & _
**HERE I NEED THE CODE TO PASTE THE RANGE FROM THE EXCEL FILE IT SHOULD BE FROM "A1:D6"**
"Thank you for your cooperation."
到
.HTMLBody = "Hello," & vbNewLine & vbNewLine & _
"Welcome to My World"& vbNewLine & vbNewLine & _
RangeToHTML(activesheet.range("A1:D6")) & _
"Thank you for your cooperation."
【讨论】：
"A1:D6" 不是合并单元格。当仅对 Range("A1") 进行编码时，这可以正常工作。我希望“A1:D6”范围位于电子邮件正文的中间。 它给我一个错误为编译错误：未定义子或函数，它在 RangeToHTML 上突出显示。 您必须从链接中复制方法。这是另一个用户创建的方法，而不是 VBA 的那个部分。 我不知道该怎么做，因为我缺乏这方面的知识。以上是关于电子邮件正文中间的范围的主要内容，如果未能解决你的问题，请参考以下文章