Outlook Macro Save Only PDF Attachments and mark Email as read

[Newfie]

Hi

I’m new to VBA and I really have no idea what I’m doing so here I am looking for help from the pro’s

I found this script online and though it would be useful, I made some changes to it however I’m having issues getting it to do exactly what I want.

The below works to a point, it will save all PDF attachments to c:\test\, mark the emails as read, if there is no attachment it will keep the email as unread, however if there are any other attachments xlxs, docx. txt, etc……. it does not save them(which it what I want) but it marks the email as read(which I do not want) I only want emails with PDF to be marked as read.


Sub SaveAttachments()

Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim avDate() As String
Dim vDate As String
Dim i As Long

Const myPath As String = "C:\test\"

ReDim Preserve avDate(3)

Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")

Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)

For Each myItem In myFolder.Items
If myItem.UnRead = True Then
avDate = Split(CStr(myItem.ReceivedTime), "/")


vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments

If UCase(Right(myAttachment.FileName, 3)) = "PDF" Then
i = i + 1
myAttachment.SaveAsFile (myPath & vDate & " - " & i & " - " & _
myAttachment.FileName)

End If
Next
myItem.UnRead = False
End If
End If
Next

End Sub

 

[Newfie]

Sorry for the delayed reply, this one seems to work great. Thanks for all your help Taylor