Sub demo()
Dim lastRow As Long, pos As Long, i As Long, count As Long, path As String, key As String, data(), result(), dic As Object
    With Worksheets("Sheet1")
        lastRow = .Cells(Rows.count, "A").End(xlUp).Row
        If lastRow = 1 Then Exit Sub    ' there is no data in Sheet1
        data = .Range("A2").Resize(lastRow - 1, 2).Value    ' data from sheet1 to data()
    End With
    With Worksheets("Sheet2")
        lastRow = .Cells(Rows.count, "A").End(xlUp).Row
        If lastRow = 1 Then Exit Sub    ' there is no data in Sheet2
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    For i = 1 To UBound(data, 1)
        path = data(i, 2)   ' column B sheet1
        pos = InStrRev(path, "\")
        If pos > 0 Then
            key = Mid(path, pos + 1, Len(path))
            If Not dic.exists(key) Then dic.Add key, data(i, 1) ' item = column A
        End If
    Next i
    data = Worksheets("Sheet2").Range("A2").Resize(lastRow - 1, 5).Value    ' data from sheet2 to data()
    ReDim result(1 To UBound(data, 1), 1 To 1)  ' result in one column: <column A sheet1)><sheet2: <SN><Title>< Date><Name>>
    For i = 1 To UBound(data, 1)
        key = data(i, 5)
        If dic.exists(key) Then
            count = count + 1
            result(count, 1) = dic.Item(key) & " " & data(i, 1) & " " & data(i, 3) & " " & data(i, 4) & " " & data(i, 5)
        End If
    Next i
    If count Then
        Worksheets("Sheet3").Range("A2").Resize(count).Value = result
    End If
    
    Set dic = Nothing
End Sub