如何仅将电子邮件正文中的可见单元格粘贴 [英] How to only paste visible cells in an email body

问题描述

我正在尝试将整个工作表复制到电子邮件正文中，并且工作表已被过滤并隐藏行。我只想将可见的行复制到电子邮件中。我以为我的代码会这样做，但是当人们回复电子邮件时，电子邮件中就会出现整个表单（隐藏和未隐藏）。任何想法？

I am trying to copy an entire sheet into an email body and the sheet is already filtered and hides rows. I want to copy only the visible rows into the email. I thought my code would do that but when the people reply to the emails, the entire sheet (both hidden and unhidden) appears in the email. Any ideas?

Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
'Working in Excel 2002-2013
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range

    On Error GoTo StopMacro

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

    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("Test").Range("A1").SpecialCells(xlCellTypeVisible)

    'Remember the activesheet
    Set AWorksheet = ActiveSheet

    With Sendrng

        ' Select the worksheet with the range you want to send
        .Parent.Select

        'Remember the ActiveCell on that worksheet
        Set rng = ActiveCell

        'Select the range you want to mail
        .Select

        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = "Test"

            With .Item
                .To = "[e-mail]"
                .CC = ""
                .BCC = ""
                .Subject = "Test"
                .Send
            End With

        End With

        'select the original ActiveCell
        rng.Select
    End With

这实际上是从这个Ron de Bruin的例子2，一些代码来自另一个例子。

推荐答案

下面的代码似乎工作。
您必须使用范围的选择/激活和其他详细信息填写。

The code below seems to work. You will have to fill it in with Ranges selection/activation and other details as needed.

编辑最后一步是发送电子邮件（按照OP的添加请求）。 DoEvents 由于 Excel VBA：发送Outlook电子邮件不包括粘贴范围

EDIT The final step is sending the email (as per an added request of the OP). DoEvents added thanks to an answer to Excel VBA: Sent Outlook email does not include pasted Range

Sub SendEmail()

    Dim OutlookApp As Object
    'Dim OutlookApp As Outlook.Application
    Dim MItem As Object
    'Dim MItem As Outlook.MailItem

    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    'Set OutlookApp = New Outlook.Application

    Dim Sendrng As Range
    Set Sendrng = Worksheets("Test").Range("A1").SpecialCells(xlCellTypeVisible)
    Sendrng.Copy

    'Create Mail Item
    Set MItem = OutlookApp.CreateItem(0)
    'Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = "[e-mail]"
        .Subject = "Test"
        .CC = ""
        .BCC = ""
        '.Body = "a"
        .Display
    End With
    SendKeys "^({v})", True
    DoEvents
    With MItem
        .Send
    End With

    Set OutlookApp = Nothing
    Set MItem = Nothing

End Sub

这篇关于如何仅将电子邮件正文中的可见单元格粘贴的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！