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