Program Outlook nie może wykonać tej akcji na tego typu załącznikach

Question

Próbuję zapisać załączniki z wiadomości e-mail. Otrzymuję komunikat o błędzie

Program Outlook nie może wykonać tej akcji na tego typu załącznikach

Używając Debug.Print outAttachment, próbuje wyodrębnić obraz (mapę bitową niezależną od urządzenia).
Potrzebuję tylko wyodrębnionych plików Excel i PDF, ale nie mam nic przeciwko wyodrębnieniu obrazu, jeśli oznacza to, że kod działa.

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

To jest wiadomość w formacie RT z osadzonymi obiektami OLE, prawda? Outlook Object Model nie pozwala na wiele z załącznikami tego typu (Attachment.Type == olOLE).

Jeśli skorzystanie z wykupu jest opcją, jego RDOAttachment . SaveAsFileMetoda jest wystarczająco inteligentna, aby wyodrębnić dane plików BMP, EMF, PDF, Excel itp. z magazynu. Coś takiego jak poniżej (z góry mojej głowy) powinno załatwić sprawę:

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