Outlook ne peut pas effectuer cette action sur ce type de pièce jointe

Nov 19 2020

J'essaie d'enregistrer les pièces jointes d'un e-mail. Je reçois le message d'erreur

Outlook ne peut pas effectuer cette action sur ce type de pièce jointe

En utilisant Debug.Print outAttachment, il essaie d'extraire une image (Bitmap indépendant du périphérique).
Je n'ai besoin que de l'extraction d'Excel et de pdf, mais cela ne me dérange pas d'extraire l'image si cela signifie que le code fonctionne.

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

Réponses

1 DmitryStreblechenko Nov 19 2020 at 04:28

Il s'agit d'un message au format RT avec des objets OLE incorporés, n'est-ce pas? Outlook Object Model ne permet pas de faire grand-chose avec les pièces jointes de ce type (Attachment.Type == olOLE).

Si l'utilisation de Redemption est une option, son RDOAttachment . SaveAsFileLa méthode est suffisamment intelligente pour extraire les données de fichiers BMP, EMF, PDF, Excel, etc. du stockage. Quelque chose comme ce qui suit (sur le dessus de ma tête) devrait faire le travail:

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