Sub Search()
    Dim a(), b(), t$, ii&, s$, i&, x&, ss$, d&, z&, Dict As Object, tt As Object
    Dim w As Workbook, v As Worksheet ', vm As Worksheet
    d = timeGetTime
    Set vm = Sheets("1")
    vm.Columns("F").ClearContents
    For Each w In Application.Workbooks
        If w.Name = "test.xlsm" Then
            With w.Sheets("2")
                ii = .Cells(.Rows.Count, 1).End(xlUp).Row
                a = Range(.Cells(2, "F"), .Cells(ii, "S"))
            End With
            Exit For
        End If
    Next
       With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a)
            .Item(a(i, 1) & " " & a(i, 3)) = a(i, 5) & "|" & a(i, 11) & "|" & a(i, 7)
        Next
        vm.Activate
        ii = Cells(Rows.Count, 2).End(xlUp).Row
        a = Range("B2:C" & ii).Value
        b = Range("F2:F" & ii).Value
        
        For x = 2 To ii - 1
            t = a(x, 1) & " " & a(x, 2)
            If .Exists(t) Then
            b(x, 1) = .Item(t)
        
            End If
            z = z + 1
            
        Next x
    End With
  Range("F2:F" & ii).Value = b
     
    
End Sub

Dim objOutlook As Outlook.Application
Set objOutlook = GetObject(, "Outlook.Application")
objOutlook.Session.Folders("vasya@mail.ru").Folders("Xyz").Display