VBA Outlook

Hej.

Jeg får en del jpg.filer ind på min mail via nogle overvågningskameraer

Mailen er ikke min standard mail, da jeg har flere mailkonti, og denne mailkonti benyttes alene til dette formål.

Ønske:

1. Kopiere vedhæftede jpg.filer fra alle mails i indbakke til en folder på min PC.
2. Slet mails i indbakke, der er mere end 10 dage gammel.

Følgende script virker på nye mails alene via en regel, der "runner" scriptet:

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\navn\Documents\Overvågning\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

Jeg vil bare gerne have et script, der tager alle mails (ikke kun nye), men nedenstående script (som virker) tager kun de valgte mails, og jeg kan ikke få VBA til at vælge alle mails (Crtl +A) inden scriptet køres.

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = Application

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

' The attachment folder needs to exist
' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\Overvågning\"
    ' Check each selected item for attachments.
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
       
    If lngCount > 0 Then
   
    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.
   
    For i = lngCount To 1 Step -1
   
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
   
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
   
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
   
    Next i
    End If
   
    Next
   
ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Endelig vil jeg gerne flyttes mails i denne mailsboks´indbakke, som er mere end 10 dage gammel via VBA --> må gerne køre i forlængelse af ovenstående script.

Jeg har ledt overalt, men jeg håber, at I kan hjælpe.

Tak.