0

I'm working on a VBA script for Outlook, that sorts emails so only emails with PDF files are in the inbox.

I have thanks to a previous answered question in Stackoverflow gotten this VBA script working and doing the tasks.

Sub MoveMail(Item As Outlook.MailItem)
    
If Item.Attachments.Count > 0 Then
    
    Dim attCount As Long
    Dim strFile As String
    Dim sFileType As String
    
    attCount = Item.Attachments.Count
    
    For i = attCount To 1 Step -1
        strFile = Item.Attachments.Item(i).FileName
          
        sFileType = LCase$(Right$(strFile, 4))
        
        Select Case sFileType
            Case ".txt", ".doc", "docx", ".xls", "xlsx"
            ' do something if the file types are found
            ' this code moves the message
            Item.Move (Session.GetDefaultFolder(olFolderInbox).Folders("Reply"))
         
            ' stop checking if a match is found and exit sub
            GoTo endsub
        End Select
    Next i
    
End If
     
endsub:
    
    Set Item = Nothing
     
End Sub

I need to also sort emails without attachment.

How do I check emails if the attachment is other then PDF or doesn't have any attachment then move it to a folder in Outlook called Reply?

Community
  • 1
  • 1

1 Answers1

0

Used solution found on Moving emails with specified attachments from shared inbox to a different folder of the same shared mailbox

It answered my questions and gave me the info needed to find a solutions to my own questions and made it possible to create this script

Sub MoveMail(Item As Outlook.MailItem)

    Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

    Dim myAtt As Outlook.Attachment
    Dim allPdf As Boolean
    Dim hidNum As Integer
    allPdf = True
    hidNum = 0
    Dim pa As PropertyAccessor

    For Each myAtt In Item.Attachments
        Debug.Print myAtt.DisplayName
        Set pa = myAtt.PropertyAccessor

        If pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
            hidNum = hidNum + 1
        Else
            If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) And Right(LCase(myAtt.FileName), 4) <> ".pdf" Then
                allPdf = False
            End If
        End If
    Next

    If allPdf = False Or Item.Attachments.Count = hidNum Then
        Item.Move (Session.GetDefaultFolder(olFolderInbox).Folders("Reply"))
    End If

    Set myAtt = Nothing
    Set pa = Nothing

End Sub
  • Your answer could be improved with additional supporting information. Please [edit] to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers [in the help center](/help/how-to-answer). – Community Nov 16 '21 at 08:43