如何仅粘贴电子邮件正文中的可见单元格

时间:2013-12-31 18:14:05

标签: excel vba email outlook

我正在尝试将整个工作表复制到电子邮件正文中,工作表已经过滤并隐藏了行。我想只将可见行复制到电子邮件中。我认为我的代码会这样做,但当人们回复电子邮件时,整个工作表(隐藏和未隐藏)都会出现在电子邮件中。有什么想法吗?

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 = "test@email.com"
                .CC = ""
                .BCC = ""
                .Subject = "Test"
                .Send
            End With

        End With

        'select the original ActiveCell
        rng.Select
    End With

这主要来自this Example 2 of Ron de Bruin,其中一些代码来自another example

2 个答案:

答案 0 :(得分:0)

以下代码似乎有效。 您必须根据需要填写Range选择/激活和其他详细信息。

编辑最后一步是发送电子邮件(根据OP的添加请求)。 DoEvents感谢回答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 = "test@email.com"
        .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

答案 1 :(得分:-1)

由于您未说明必须使用VBA(至少在首次发布此答案时),您可能会:

转到首页 - >找到&选择 - >转到特别 - >仅可见细胞。然后复制并粘贴到您的电子邮件中。这对我有用。