VBA: Extracting mail attachements from archived mails

Like many others, i had a problem extracting attachement from archived mail items.

The name of the attachement is "@"  instead of the actual file name.

It was suggested in a particular mail to use the API, but you need EVAdmin to do so. (CreateObject("EnterpriseVault.ContentManagementAPI") failed)

Another suggestion was to read the HTMLbody of the mail and search for the filename.

After a little research, i found that, if you "Display" the mailitem, it will be accessible as any other mailitem, including the attachements.

Here's the code:

• Private Function GetSelectedMailAttach() As String
•     Dim olApp As Outlook.Application
•     Dim olExp As Outlook.Explorer
•     Dim olSel As Outlook.Selection
•     Dim olItem As Outlook.MailItem
•     Dim olAtt As Outlook.Attachment
•     Dim olInsp As Outlook.Inspector
•     Dim olSelItem As Outlook.MailItem
•     Dim olOpnItem As Outlook.MailItem
•     Dim i As Long
•     Dim strRet As String
•    
•     On Error GoTo ErrorHandler
•    
•     Set olApp = GetObject("", "Outlook.Application")
•     Set olExp = olApp.ActiveExplorer
•     Set olSel = olExp.Selection
•     If olSel.Count = 0 Then
•         MsgBox "No mailitems selected!", vbExclamation
•         GoTo Finalize
•     End If
•    
•     For i = 1 To olSel.Count
•         Set olInsp = Nothing
•         Set olSelItem = olSel.item(i)
•         olSelItem.Display
•        
•         Do While olInsp Is Nothing
•             Set olInsp = olApp.ActiveInspector
•         Loop
•        
•         Set olOpnItem = olInsp.CurrentItem
•         For Each olAtt In olOpnItem.Attachments
•             If olAtt.Type <> olOLE Then
•                 olAtt.SaveAsFile Environ("TEMP") & "\" & olAtt.DisplayName
•                
•                 If strRet = "" Then
•                     strRet = Environ("TEMP") & "\" & olAtt.FileName
•                 Else
•                     strRet = strRet & vbCrLf & Environ("TEMP") & "\" & olAtt.FileName
•                 End If
•             End If
•         Next
•        
•         olOpnItem.Close olDiscard
•     Next
•    
•     If strRet = "" Then
•         MsgBox "No attachements found in selected mails!", vbExclamation
•     End If
•    
•     GetSelectedMailAttach = strRet
•    
•     GoTo Finalize
•    
• ErrorHandler:
•     MsgBox Err.Description, vbCritical
• Finalize:
•     Set olAtt = Nothing
•     Set olItem = Nothing
•     Set olSel = Nothing
•     Set olExp = Nothing
•     Set olApp = Nothing
•     Set olInsp = Nothing
•     Set olSelItem = Nothing
•     Set olOpnItem = Nothing
• End Function