Outlook cannot perform this action on this type of attachment

Question

I am trying to save attachments from an email. I get the error message

Outlook cannot perform this action on this type of attachment

Using Debug.Print outAttachment, it is trying to extract a Picture (Device Independent Bitmap).
I only need the Excel and pdf extracted, but I don't mind extracting the picture if it means the code works.

Public Sub Extract_Attachments_From_Outlook_Msg_Files()
    
    Dim outApp As Object
    Dim outEmail As Object
    Dim outAttachment As Object
    Dim msgFiles As String, sourceFolder As String, saveInFolder As String
    Dim fileName As String
    Dim FilePath As String
    
    Application.DisplayAlerts = False
           
    msgFiles = Sheets("Instructions").Range("H1") & Sheets("Instructions").Range("H2") & ".msg" 'folder location and filespec of .msg files"
    Debug.Print msgFiles
    saveInFolder = Sheets("Instructions").Range("H1")         'folder where extracted attachments are saved
    Debug.Print saveInFolder
        
    If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
        sourceFolder = Left(msgFiles, InStrRev(msgFiles, "\"))
        Debug.Print sourceFolder
        On Error Resume Next
        Set outApp = GetObject(, "Outlook.Application")
        If outApp Is Nothing Then
            MsgBox "Outlook is not open"
            Exit Sub
        End If
        On Error GoTo 0
        
        fileName = Dir(msgFiles)
        While fileName <> vbNullString
        
        Set outEmail = outApp.Session.OpenSharedItem(sourceFolder & fileName)
            
        For Each outAttachment In outEmail.Attachments
            outAttachment.SaveAsFile saveInFolder & outAttachment.fileName
        Next
        
        fileName = Dir
            
    Wend
        
End Sub

Answer 1

This is an RTF-formatted message with embedded OLE objects, right? Outlook Object Model does not allow to do much with attachments of that type (Attachment.Type == olOLE).

If using Redemption is an option (I am its author), its RDOAttachment.SaveAsFile method is smart enough to extract BMP, EMF, PDF, Excel, etc. file data from the storage. Something like the following (off the top of my head) should do the job:

  set Session = CreateObject("Redemption.RDOSession")
  set outEmail= Session.GetMessageFromMsgFile(sourceFolder & fileName)
  For Each outAttachment In outEmail.Attachments
      outAttachment.SaveAsFile saveInFolder & outAttachment.fileName
  Next