Attribute VB_Name = "Module4"
Dim xlapp As Object, xlsheet As Object

Sub failedtoexcel()

Dim aObjNSMapi As NameSpace
Dim aObjMapiFold As MAPIFolder, targfolder As MAPIFolder
Dim recMail As MailItem
Dim Messubj As String, Mesbody As String
Dim total As Integer
Dim adr() As Variant
ReDim adr(0)
Dim pl As Integer, pl1 As Integer

Set aObjNSMapi = GetNamespace("MAPI")
Set aObjMapiFold = aObjNSMapi.GetDefaultFolder(olFolderInbox)
total = aObjMapiFold.items.Count

For j = total To 1 Step -1
    
    If aObjMapiFold.items(j).Class = olMail Then
        Set recMail = aObjMapiFold.items(j) '.GetLast 'First 'targfolder.items.GetFirst
    
    'If recMail.Class = olMail Then
        Messubj = recMail.Subject
        If InStr(Messubj, "Undelivered Mail") <> 0 Then
            Mesbody = recMail.Body
            pl1 = InStr(LCase(Mesbody), ">: host")
            pl = InStrRev(LCase(Mesbody), "<", pl1)
            ReDim Preserve adr(UBound(adr) + 1)
            adr(UBound(adr)) = Mid(Mesbody, pl + 1, pl1 - pl - 1)
        End If
    End If
Next

Set xlsheet = CreateObject("Excel.sheet")

Set xlapp = xlsheet.Application
xlapp.Visible = True
'xlapp.workbooks.Add
For i = 1 To UBound(adr)
    xlapp.cells(i, 1).Value = adr(i)
Next i
'Set xlapp = Nothing
'Set xlsheet = Nothing

End Sub