提取多个附件

Question

我需要从电子邮件、共享邮箱中提取所有附件，它可以是可变的（有时一个有时多个但总是 PDF）。

只下载第一个

此外，我还有另一个脚本可以对子文件夹中的电子邮件进行分类。我正在使用 mailitem.move 方法，它只移动一半一半的电子邮件。这是 Outlook 的限制还是 VBA?

我的提取附件的脚本。

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

请尝试更改此代码部分：

  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

这个：

  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

提取多个附件

Extract more than one attachment

outlook

vba