VBA Vlookup для отправки электронной почты не соответствует конкретным электронным письмам - PullRequest
Новая
       37

VBA Vlookup для отправки электронной почты не соответствует конкретным электронным письмам

0 голосов
/ 17 апреля 2019

Я пытаюсь Vlookup определенной ячейки, чтобы вернуть совпадение в списке контактов. Когда он находит это совпадение, он отправляет электронное письмо этому конкретному человеку, связанному с этим местоположением. Vlookup работает и электронная почта работает, но когда дело доходит до отправки электронной почты, электронная почта заполняет все имена в списке имен, а не только конкретную электронную почту, связанную с этим местоположением, или ячейку, в которой выполняется поиск. 

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 связано с этим местоположением, оно отправляет электронное письмо только Джону Смиту. В этом случае мой код отправляет электронное письмо всем в списке контактов.

1 Ответ

0 голосов
/ 04 июня 2019

У вас есть это: 

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

Разве это не должно быть функцией Vlookup?

...