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