vba - 隐藏要粘贴到电子邮件中的 Excel 范围中的信息

Question

我有一个宏，可以将 Excel 范围粘贴到电子邮件中。该范围具有条件格式，可将背景颜色和字体颜色变为黑色以隐藏信息。

粘贴到 Outlook 中时，黑色背景区域的字体从黑色变为白色。

Sub OpenOutlookEmail()
Dim OutApp As Object
Dim outMail As Object
Dim rng As Range
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set outMail = OutApp.CreateItem(0)
Set rng = ActiveSheet.Range("A1:P35")
On Error Resume Next
With outMail
    .To = "<a href="https://stackoverflow.com/cdn-cgi/l/email-protection" class="__cf_email__" data-cfemail="20434f574f524b455253604d450e434f4d" rel="noreferrer noopener nofollow">[email protected]</a>"
    .CC = 
    .BCC = ""
    .Subject = "Subject"
    .HTMLBody = "Hello," & vbNewLine _
      vbNewLine & "Body" & _
      RangetoHTML(rng) & "Thanks!" 
    .Display
End With
On Error GoTo 0
Set outMail = Nothing
Set OutApp = Nothing
End Sub

我编辑了一些信息。

Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, 
'  Outlook  2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 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 workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , True, 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 an .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 the RangetoHTML subroutine.
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.
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

是否可以作为图片发送或更改 Outlook 中的设置，以便它不会重新格式化文本？

Answer 1

更改为黑色背景上的黑色字体或白色背景上的白色字体可能是“隐藏”单元格值的最明显方法，但这肯定不是最好的方法。

手动或使用条件格式将单元格数字格式更改为自定义数字格式 ;;;。这会使单元格显示显示为空白，同时保留基础值。