隐藏行后如何生成具有选定范围的电子邮件正文

Question

我有一个宏，可从Excel工作表生成Outlook电子邮件。当所有行都未隐藏时，它可以正常工作，但是如果隐藏了一个或多个行，则生成空白正文。

根据工作表中的其他输入，我是否需要显示行。

尝试以各种方式编写代码，以仅显示可见的单元格，但没有任何效果。我相信问题在于：

Set OutBody = Sheets("Email1").Range("A2:H24").SpecialCells(xlCellTypeVisible)

，或者仅仅是RangetoHTML函数。

请打开其他建议以隐藏或删除不需要的行，然后再生成电子邮件或生成电子邮件正文（如果它与隐藏的行一起工作）。

Sub RtoGemail()
'
' RtoGemail Macro
' 
'


Dim OutApp As Object
Dim OutMail As Object
Dim OutBody As Range
Dim Sendto As Range


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


Set OutBody = 
Sheets("Email1").Range("A2:H24").SpecialCells(xlCellTypeVisible)

Set Sendto = Worksheets("Rtl to Grp").Range("D15")

On Error Resume Next


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    .SentOnBehalfOfName = "fakename"
    .To = "" & Sendto  'Change email address here'
    .Subject = "" & Worksheets("Email1").Range("A1")
    .HTMLBody = RangetoHTML(OutBody)
    .display
    End With

Set OutMail = Nothing
Set OutApp = Nothing

On Error GoTo 0

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

End Sub

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

即使隐藏行，也应使用范围A2：H24生成电子邮件正文。 而是，生成空白电子邮件正文。