Excel列表可在Outlook主题中搜索并使用自定义正文进行打印

我正在处理代码，以便从我的excel列表（A列）中提取带有特定“订单号”的电子邮件，并在搜索中找到该电子邮件后将其打开，然后转发/编辑该电子邮件以添加发票编号并进行打印，我不希望将其转发到其他电子邮件地址，但是我希望在电子邮件正文中添加相应的发票编号，即在创建订单编号后从系统收到的电子邮件以进行物理打印。

我已经能够找到电子邮件并编辑主题，但是我无法创建循环。

我要实现的是在Outlook搜索主题中搜索A2（订单号），然后在主题中粘贴B2（发票号）而不是我现在提到的常量“ 123”的循环。循环移动以搜索a3，然后在打印之前将b3粘贴到主题行中。

我无法创建此循环，有人可以帮忙吗。

下面是我的数据示例

我的代码

Option Explicit
Public Sub Test_sofWorkWithOutlook()
Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object
Dim olMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim strNum As String
Dim xlSheet As Worksheet
Dim LastRow As Long,lngRow As Long
Dim Subject As Long
'Use the code from the link below to start Outlook properly from Excel
'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'Set olApp = outlookApp()
Set olApp = GetObject(,"Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6)
'Set Subject = MailItem.Subject
Set xlSheet = activeSheet
With xlSheet
LastRow = .Cells(.Rows.Count,"A").End(xlUp).Row
For lngRow = 2 To LastRow
strNum = .Cells(LastRow,1)
For Each olMail In olFldr.Items
If TypeName(olMail) = "MailItem" Then
If (InStr(1,olMail.Subject,strNum,vbTextCompare) > 0) Then
With olMail
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor 'access the message body for editing
Set oRng = wdDoc.Range 'orng is the message body
.Display
'edit oRng as required
'.Save
.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