Extract more than one attachment

Question

I need to extract all the attachements from an email, from a shared mail box, it can be variable (sometimes one sometimes more than one but always PDF).

It only downloads the first one.

Also I have another script that classifies the email in subfolder. I’m using the mailitem.move method, and it only moves half by half the email. Is this a limitation from Outlook or VBA?

My script for extracting attachments.

Sub ExtrairePJ_Mail()
    'Déclaration des variables.
    Dim oMail As MailItem
    Dim myFolder As Folder
    Dim myOlApp As Outlook.Application
    Dim myNamespace As Namespace
    Dim NameFile As String
    
    
    ' variables liées à Outlook.
    Set myOlApp = Outlook.Application
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox).Folders("Diffusion")
    Set mydestFolder = myNamespace.GetDefaultFolder(olFolderInbox).Folders("director")
    'Set pj = Outlook.
    'Variable modiafiable.
    n = 1 'Numéro en cas d'existance de fichier.
    FolderPath = "path"  'Chemin du dossier où l'on souhaite sauvegarder le fichier
    'NameFile = oMail.Attachments.Item(1).Filename & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & ".pdf" 'Nom du fichier format : Nom de la piece jointe-mm-dd-yyyy.pdf
    
    'Boucle parcourant la boite mail
    For Each oMail In myFolder.Items
        'Condition vérifiant si l'objet est "AUD_ACTTER Reports the active terminals of users who did not sign off properly"
        'If oMail.subject Like "*" & "AUD_ACTTER Reports the active terminals of users who did not sign off properly" & "*" Then
        
        If oMail.subject Like "*" & "test2pj" & "*" Then
            Debug.Print oMail.subject & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & "-" & n
            
            oMail.Attachments.Item(1).SaveAsFile FolderPath & oMail.Attachments.Item(1).Filename & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & ".pdf"

            Set pj = Nothing
            n = n + 1
        End If
    Next oMail    
End Sub

Answer 1

Please, try changing of this code part:

  If oMail.subject Like "*" & "test2pj" & "*" Then
            Debug.Print oMail.subject & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & "-" & n
            
            oMail.Attachments.Item(1).SaveAsFile FolderPath & oMail.Attachments.Item(1).Filename & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & ".pdf"

            Set pj = Nothing
            n = n + 1
  End If

with this one:

  Dim strName As String
  Dim oAtach As Attachment 'put this line somewhere to the code beginning
  If oMail.subject Like "*" & "test2pj" & "*" Then
        'Debug.Print oMail.subject & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & "-" & n
            
        For Each oAtach In oMail.Attachments
            strName = Split(oAtach.DisplayName, ".")(0)
            If Dir(folderPath & strName & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & ".pdf") = "" Then
                oAtach.SaveAsFile folderPath & strName & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & ".pdf"
            Else
                oAtach.SaveAsFile folderPath & strName & "-" & Format(oMail.ReceivedTime, "mm-dd-yyyy") & n & ".pdf"
                n = n + 1
            End If
        Next
        Set pj = Nothing
  End If