How to Open Insert Item Dialog From Outlook Using VBA

My project requires user to select and attach a existing mail from Outlook to new mail. I am trying to find how to get the below dialog to show in outlook using VBA to allow user to select the mail to attach. Could anyone guide me.

I tried to look at outlook object if it supports showing any such dialog through VBA but could not find any way to display it.

I solved it myself after a lot of trial and error. Here is my solution.

It demonstrates how to attach an email to a new email as well as how to get email item selection from user input and then save all the attachments from that email. Hope it is helpful.

Dim FilePath As String
    
Function getUserEmailSelection() As Object
    Dim o As Object, mailWindow As Object
    Dim myItem As Object, objMsg As Object, oA As Object
    Set o = CreateObject("Outlook.Application")
    FilePath = Environ("TEMP") & "\" & Format(Now, "yyyy-mm-dd H-mm") & " "
    
    Set objMsg = o.CreateItem(0)
    Set mailWindow = objMsg.GetInspector
    mailWindow.Display
    mailWindow.WindowState = 1
    mailWindow.CommandBars.ExecuteMso "AttachItem"
    
    On Error GoTo DialogCancelled
    Set oA = objMsg.Attachments(1)
    objMsg.Close 1
    Set mailWindow = Nothing
    On Error GoTo 0
    
    FilePath = FilePath & oA.Filename
    oA.SaveAsFile FilePath
    Set myItem = o.CreateItemFromTemplate(FilePath)
    Set getUserEmailSelection = myItem
    
    Exit Function
    
    DialogCancelled:
    Err.Clear
    objMsg.Close 1
    Set getUserEmailSelection = Nothing
End Function

For Testing, here is the code:

Sub SaveAllAttachments()
    Dim olMail As Object, objAttachments As Object, lngCount As Long
    Dim strFolderpath As String, strFile As String, i As Long
    strFolderpath = "C:\Users\BD\Local\New folder\"
    Set olMail = getUserEmailSelection()
    If Not olMail Is Nothing Then
    Set objAttachments = olMail.Attachments
        lngCount = objAttachments.Count
        If lngCount > 0 Then
            For i = lngCount To 1 Step -1
                strFile = objAttachments.Item(i).Filename
                strFile = strFolderpath & strFile
                objAttachments.Item(i).SaveAsFile strFile
            Next
        End If
    Kill FilePath
    End If
End Sub