使用 Vlookup 发送电子邮件以匹配电子邮件地址

Question

我正在尝试查找一个单元格以返回联系人列表中的匹配项。

当它发现匹配时，它应该向与该位置相关联的人发送一封电子邮件。

Sub vLookupAnotherWorksheet()
    Dim myLookupValue As String
    Dim myFirstColumn As Long
    Dim myLastColumn As Long
    Dim myColumnIndex As Long
    Dim myFirstRow As Long
    Dim myLastRow As Long
    Dim myVLookupResult As Long
    Dim myTableArray As Range
    
    myLookupValue = "H3:H13"
    myFirstColumn = 1
    myLastColumn = 8
    myColumnIndex = 8
    myFirstRow = 3
    myLastRow = 13
    
    With Worksheets("EVC_Contact_List")
        Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
    End With
    
    On Error Resume Next
    myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, myColumnIndex, False)
    
    If IsError(myVLookupResult) = False Then
        Call Send_Email(myvalue)
    End If
    
End Sub
    
Sub Send_Email(myvalue As Variant)
        
    Dim Email_Subject As String, Email_Send_From  As String, Email_Body As String, i As Integer
    Dim Mail_Object As Object, nameList As String, namelist2 As String, o As Variant
    
    Email_Send_From = ""
        
    If Sheets("EVC_Contact_List").Cells(2, 4).Value <> "" Then
        nameList = Join(Application.WorksheetFunction.Transpose(Sheets("EVC_Contact_List").Range("D2:D29")))
        namelist2 = Join(Application.WorksheetFunction.Transpose(Sheets("EVC_Contact_List").Range("F2:F29")))
    End If
  
    Set Mail_Object = CreateObject("Outlook.Application")
    With Mail_Object.CreateItem(o)
        .Subject = "Unit(s) Excceding Days as Loaner"
        .To = nameList
        .Cc = namelist2
        .display
    End With
    Application.DisplayAlerts = False
    
End Sub

如果在联系人列表中找到位置 XXXX，并且 Johnsmith@gmail.com 与该位置相关联，则它应仅向 John Smith 发送电子邮件。

我的代码正在向联系人列表中的每个人发送一封电子邮件。

Answer 1

你有这个：

nameList = Join(Application.WorksheetFunction.Transpose(Sheets("EVC_Contact_List").Range("D2:D29")))

不应该是Vlookup功能吗？