View Single Post
 
Old 11-14-2014, 07:38 AM
terrymac terrymac is offline Windows XP Office 2007
Novice
 
Join Date: Nov 2014
Posts: 8
terrymac is on a distinguished road
Default VBA Support required (trying to automatically filter PDFs from emails in specific folders.

I was hoping someone could help me, through google I have found this website.

Here is my problem; I am trying to do some VBA on my Outlook but I know nothing about it.

In my business we have specific documents that are emailed to us in PDF format, which over the coming years get updated. There are thousands of different attachments over thousands of emails, so I tried to use VB to strip the PDFs and then save them.

It all works but the one problem I have is if there is the same file, I need it to check the DATE MODIFIED of the file and overwrite if it is newer.... which would mean I will only be left with the latest of each file..

Here is my command is there a whiz out there who could tell me what to do?


Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
Dim olkFolder As Outlook.MAPIFolder, _
olkAttachment As Outlook.Attachment, _
objFSO As Object, _
strRootFolderPath As String, _
strFilename As String, _
intCount As Integer
'Change the following path to match your environment
strRootFolderPath = "Y:\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set olkFolder = Application.ActiveExplorer.CurrentFolder
If Item.Attachments.count > 0 Then
For Each olkAttachment In Item.Attachments
If objFSO.GetExtensionName(LCase(olkAttachment.FileNa me)) = "pdf" Then
strFilename = olkAttachment.FileName
intCount = 0
Do While True
If objFSO.FileExists(strRootFolderPath & strFilename) Then
intCount = intCount + 1
objFSO.deletefile (strRootFolderPath & strFilename)
Else
Exit Do
End If
Loop
olkAttachment.SaveAsFile strRootFolderPath & strFilename
End If
Next
End If
Set objFSO = Nothing
Set olkAttachment = Nothing
Set olkFolder = Nothing
End Sub
Reply With Quote