There was a typo in my original, which is why it only processed the last row and why your subsequent changes, echoed the same issue. The following should address your comments.

Public Sub Test_sofWorkWithOutlook()
Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object
Dim olMail As Object
Dim strNum As String
Dim strNum1 As String
Dim xlSheet As Worksheet
Dim LastRow As Long, lngRow As Long
Dim Subject As Long


    'Set olApp = outlookApp()
    Set olApp = GetObject(, "Outlook.Application")


    Set olNs = olApp.GetNamespace("MAPI")
    Set olFldr = olNs.GetDefaultFolder(6)


    Set xlSheet = ActiveSheet
    With xlSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngRow = 1 To LastRow
            strNum = .Cells(lngRow, 1)
            strNum1 = .Cells(lngRow, 2)
            For Each olMail In olFldr.Items
                If TypeName(olMail) = "MailItem" Then
                    If (InStr(1, olMail.Subject, strNum, vbTextCompare) > 0) Then
                        With olMail
                            .Subject = olMail.Subject & " " & strNum1
                            .PrintOut
                            Exit For
                        End With
                    End If
                End If
                DoEvents
            Next olMail
            DoEvents
        Next lngRow
    End With


    Set olMail = Nothing
    Set olFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub