Extract text string from undeliverable email body to excel

I need some help on Outlook VBA.

I am trying to write a macro in Outlook for extracting the email address from each individual undeliverables email body.

There are hundreds of emails failed for delivering, so it would be nicer if they could be extracted automatically than be copied and pasted manually.

The email body would be like:

----------------------------Email----------------------------

Delivery has failed to these recipients or groups:

XXXX@XXXXXX.XXX (XXXX@XXXXXX.XXX)

...no need info...

To: XXXX@XXXXXX.XXX

...no need info...

----------------------------Email-----------------------------

I am a completely Outlook VBA novice here, so after lots of searching and many trails I finally came up with below code:

Sub Test()
   Dim myFolder As MAPIFolder
   Dim Item As Outlook.MailItem 'MailItem
   Dim xlApp As Object 'Excel.Application
   Dim xlWB As Object 'Excel.Workbook
   Dim xlSheet As Object 'Excel.Worksheet
   Dim Lines() As String
   Dim i As Integer, x As Integer, P As Integer
   Dim myItem As Variant
   Dim subjectOfEmail As String
   Dim bodyOfEmail As String

'Try access to excel
   On Error Resume Next
   Set xlApp = GetObject(, "Excel.Application")
   If xlApp Is Nothing Then
     Set xlApp = CreateObject("Excel.Application")
     xlApp.Application.Visible = True
     If xlApp Is Nothing Then
       MsgBox "Excel is not accessable"
       Exit Sub
     End If
   End If
   On Error GoTo 0

 'Add a new workbook
   Set xlWB = xlApp.Workbooks.Add
   xlApp.Application.Visible = True
   Set xlSheet = xlWB.ActiveSheet
   Set myFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
   For Each myItem In myFolder.Items
     subjectOfEmail = myItem.Subject
     bodyOfEmail = myItem.Body

 'Search for Undeliverable email
     If bodyOfEmail Like "*Delivery*"& "*failed*" And indexOfEmail Like "*Undeliverable*" Then
       x = x + 1
 'Extract email address from email body
       Lines = Split(myItem.Body, vbCrLf)
       For i = 0 To UBound(Lines)
         P = InStr(1, Lines(i), "@", vbTextCompare)
         Q = InStr(1, Lines(i), "(", vbTextCompare)
         If P > 0 Then
           xlApp.Range("A"& x) = Trim$(Mid$(Lines(i), 1, Q - 1)) 'extract the email address
           Exit For
         End If
       Next
    End If
  Next
End Sub

It worked perfectly on my test Email Inbox, which opened an Excel sheet and listed every particular email address within the target emails.

However, when I run this code on my work email account, it didn't give me a thing. Then I found that it had trouble reading "Undeliverables" emails, and the weird thing is every time after I ran it, one of the undeliverables emails turned into Traditional Chinese characters which cannot be read at all.

Like below:

格浴㹬格慥㹤਍洼瑥⁡瑨灴攭畱癩∽潃瑮湥⵴祔数•潣瑮湥㵴琢硥⽴瑨汭※档牡敳㵴獵愭捳楩㸢⼼敨摡㰾潢祤ാ㰊㹰戼㰾潦瑮挠汯牯∽〣〰㘰∶猠穩㵥㌢•慦散∽牁慩≬䐾汥癩牥⁹慨⁳慦汩摥琠桴獥⁥敲楣楰湥獴漠⁲牧畯獰㰺是湯㹴⼼㹢⼼㹰਍昼湯⁴潣潬

I am feeling like this code works on only forwarded undeliverable email, which in my test email inbox. But it never read from the original undeliverable emails which sent from Microsoft outlook and turned those emails to Chinese characters one by one.

I googled about it, it seemed they're some bugs in Outlook for the failed delivery emails. Do any of you know how to fix this? Or is there any way to improve my code? I am open to changing anything.