Script for Outlook Rule that Saves Attachment upon conditions-CodePudding

I'm kind of struggling with this script, but I feel like it's most of the way there. The intent is to use an outlook rule to trigger a script that saves the attached files of an email only if the created date is equal to today. Next, the script would delete all other items from the folder that do not have the same created date.

Here's what I have so far. I can run the code, but it doesn't really do anything at the moment.

The logic all makes sense to me, but I must have erred in my snytax or subprocedure arguments. Can anyone else help me find the flaw(s) in my script? I'm sure there's likely more than a few.

I really appreciate the help and input. I'm a bit of a VBA novice

Public Sub SaveAttachments(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
Dim today As Date 'today's date
Dim adate As Date 'date of attachment

today = Date

sSaveFolder = "filepath"
    
For Each oAttachment In MItem.Attachments
    adate = oAttachment.DateCreated
    If DateDiff("d", today, adate) = 0 Then
    oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
    End If
Next oAttachment


Dim objFSO, objFolder, objfile As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(sSaveFolder)

For Each objfile In objFolder.files
    If Format(objfile.DateCreated, "DD-MM-YYYY") <> Format(Date, "DD-MM-YYYY") Then
        Kill objfile
    End If
Next objfile

End Sub

CodePudding user response：

I figured it out.

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
Dim keepfile As String

sSaveFolder = "filepath"
    
For Each oAttachment In MItem.Attachments
    sdate = MItem.SentOn
    If Format(sdate, "DD-MM-YYYY") = Format(Date, "DD-MM-YYYY") Then
    oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
    keepfile = oAttachment.DisplayName
    End If
Next oAttachment

Dim objFSO, objFolder, objfile As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(sSaveFolder)

For Each objfile In objFolder.files
    If InStr(objfile.Name, keepfile) = 0 Then
        Kill objfile
    End If
Next objfile

End Sub

CodePudding user response：

The Attachment class from the Outlook object model doesn't provide the DateCreated property.