将电子邮件功能添加到Excel搜索

时间:2019-02-27 21:19:37

标签: excel

我们每年都有一次贸易展览。我使用的是基于网络的登录方式,当其中一位客户出现时,该方式会通过电子邮件向我们的销售代表发送电子邮件。因此,我有一份已报名参加展会的客户清单。我想用它来签入。因此我使其可搜索。它只有5列,票号,名字,姓氏,公司名称,销售代表电子邮件。我要单击一个按钮,将其标记为“已签入”,然后将电子邮件发送到该单元格中的销售代表电子邮件,并将主题,名字和公司名称单元格组合在一起。这可行吗?预先感谢。

1 个答案:

答案 0 :(得分:0)

1。这是每个问题的样本假定数据。

Ticket# First_  Last_   Company           Sales_Rep_Email   Status
        Name    Name    Name      
1001    James   Smith   Hana Toys          abc@gmail.com     
1002    Michael Smith   Alpha Marketing    bcd@gmail.com    
1003    Robert  Smith   Baj Finance        edf@gmail.com    
1004    Maria   Smith   Home Appliances    def@gmail.com    
1005    David   Smith   IkeaMart           fgi@gmail.com    
1006    Mary    Garcia  Fruit Beverages    abc@gmail.com     
1007    Raj     Kumar   ABC Consultants    bcd@gmail.com    
1008    Deepak  Tandon  Smith and Smith    edf@gmail.com    
1009    Hary    Smih    Veritas Limited    def@gmail.com     
1010    Arun    Sharma  Lovely Lingeries   fgi@gmail.com    

    "Note: Names and companies are fictitious and have no relevance to any name or company, if exists"

B。根据状态搜索和过滤此数据。过滤后的数据就是这种形式。

Ticket# First_  Last_   Company_    Sales_Rep_      Status
        Name    Name    Name        Email
1003    Robert  Smith   Baj Finance edf@gmail.com   yes
1005    David   Smith   IkeaMart    fgi@gmail.com   yes

C。如快照中所示,已放置一个“表单控制命令”按钮,并且宏Send_Email已附加到该按钮。

54914673_b

D。这段代码对我有用。

  Sub Send_Email()
    Dim objOutlook As Object
    Dim objMail As Object
    Dim Recipients As String
    Dim CellReference As Integer
    Dim RowLimit As String
    Dim firstRow As Long
    Dim lastRow As Long
    Dim cell As Excel.Range
    Dim row As Long
    Dim substr As String


    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

        CellReference = 5

      With ActiveSheet

        'Find the first and last index of the visible range.
        firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).row
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row


        'Loop through all the rows between [firstRow] and [lastRow] established before.

        For row = firstRow To lastRow

            Set cell = .Cells(row, CellReference)
            substr = .Cells(row, 2).Value & "  " & .Cells(row, 3).Value & " , " & .Cells(row, 4).Value
            'checking if the row is hidden or visible.

            If Not cell.EntireRow.Hidden Then

                'Concatenate Recipients

                Recipients = Recipients & cell.Value & ";"
            End If

        Next row

    End With


    With objMail
        .To = Recipients
        .Subject = substr
        .Body = "Please follow up this customer"
        '.Display    'Uncomment it ,if you want to review email
        .Send
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing

End Sub