Match & copy & paste mails from folder as attachment to another mail

Question

Dear All I am suffering a code which match, copy and paste outlook mails as attachment from a given subfolder to an empty mail.

This subfolder located in my inbox which is not the default folder of mine. I have UNIQ IDs which are stored in a range of a given excel sheet. And these ID can be found in the subject of the mails of mentioned folder.

I want to stop the process if code found given nr of mails and copied them, but seems it is future project, as till now even this is not working. Empty mail opens but happens nothing..or not visible. Could you help me where is the mistake?

Sub AttachEmailsToNewEmail()

    Dim outlookApp As Outlook.Application
    Dim outlookNamespace As Outlook.Namespace
    Dim inboxFolder As Outlook.MAPIFolder
    Dim subFolder As Outlook.MAPIFolder
    Dim email As Outlook.MailItem
    Dim ws As Worksheet
    Dim idRange As range
    Dim idCell As range
    Dim uniqueID As String
    
    
    Set outlookApp = New Outlook.Application
    Set inbox = outlookApp.GetNamespace("MAPI").Folders("test@gmail.com").Folders("Inbox")
    
    
    Dim newEmail As Outlook.MailItem
    Set newEmail = outlookApp.CreateItem(olMailItem)
    newEmail.Display
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set idRange = ws.range("A1:A10")
    
    ' Loop through each unique ID in the range
    For Each idCell In idRange
        uniqueID = idCell.Value
        
        ' Search for emails with the matching unique ID in the subject
        For Each email In inbox.Items
            If InStr(1, email.subject, uniqueID, vbTextCompare) > 0 Then
                ' Attach the email to the new email item
                email.Attachments.Add newEmail, olEmbeddeditem
                Exit For ' Exit the loop once a matching email is found
            End If
        Next email
    Next idCell
    
    
End Sub

Answer 1

No error generates, which is troubling.

Replace

email.Attachments.Add newEmail, olEmbeddeditem

with

newEmail.Attachments.Add email, olEmbeddeditem