Saving Email Attachments automatically

Question

I have a task that I need to complete for my job. I need to write a code that saves down pdf attachments from Outlook emails in a target shared drive folder. It seems easy enough I thought but unfortunately the run a script option has been disabled. I also tried to use Python but I cannot set up a task schedule as I do not have admin rights. Is there a way to copy paste a code into THisOutLookSession with the help of VBA and then run this continuously? The emails should be saved down as soon as they hit the inbox.

I tried the below code from some other post but nothing is working

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

Dim olNs As Outlook.NameSpace
Dim Inbox  As Outlook.MAPIFolder
Dim Filter As String

Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                   Chr(34) & " Like '%TEST%' AND " & _
                   Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                   Chr(34) & "=1"

Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items.Restrict(Filter)

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Dim AtmtName As String
        Dim FilePath As String
            FilePath = "C:\Temp\"

    
    Dim Atmt As Attachment
    For Each Atmt In Item.Attachments
        AtmtName = FilePath & Atmt.FileName
        Debug.Print AtmtName ' Print on Immediate Window
        Atmt.SaveAsFile AtmtName
    Next
    End If
End Sub

Alternatively, if you use _Exchange Online_ and _Flow_, you can set up a task that automatically retrieves all attachments from incoming e-mails and save them in an _OneDrive_ folder. — Gustav, Apr 04 '22 at 11:28
Does this answer your question? [How do I trigger a macro to run after a new mail is received in Outlook?](https://stackoverflow.com/questions/11263483/how-do-i-trigger-a-macro-to-run-after-a-new-mail-is-received-in-outlook) — niton, Apr 07 '22 at 14:31
Remove the filter. The applicable collection is all the items in the folder. `Set Items = Inbox.Items`. Verify the subject and presence of an attachment in `Private Sub Items_ItemAdd(ByVal Item As Object)`. — niton, Apr 07 '22 at 14:34

score 1 · Answer 1 · answered Apr 05 '22 at 15:53

Is there a way to copy paste a code into THisOutLookSession with the help of VBA and then run this continuously?

The code can be run only when Outlook is running. VBA macros can't be run without Outlook launched and macros allowed to be run.

You can handle all incoming emails by using the NewMailEx event of the Application class which is fired when a new message arrives in the Inbox and before client rule processing occurs. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. So, you are interested in processing meeting items only. To recognize the item you need to get an instance of the incoming Outlook item. Use the Entry ID returned in the EntryIDCollection string to call the NameSpace.GetItemFromID method and process the item.

Also you may consider hooking up the ItemAdd event on the folder. The event is fired when one or more items are added to the specified collection. Note, this event does not run when a large number of items are added to the folder at once. It seems you already do that, but there is no need to run the restrict method to find items.

But to run a code routine which searches for items with attachments periodically you can use a timer. The Outlook object model doesn't provide anything for that, but you can use Windows API functions for that. For example:

Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong

Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
  MsgBox "The TriggerTimer function has been automatically called!"
End Sub


Public Sub DeactivateTimer()
Dim lSuccess As LongLong              '<~ Corrected here
  lSuccess = KillTimer(0, TimerID)
  If lSuccess = 0 Then
    MsgBox "The timer failed to deactivate."
  Else
    TimerID = 0
  End If
End Sub

Public Sub ActivateTimer(ByVal nMinutes As Long)
  nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
  If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
  TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
  If TimerID = 0 Then
    MsgBox "The timer failed to activate."
  End If
End Sub

See Outlook VBA - Run a code every half an hour for more information.

Voted up for your fully clear answer – Waleed Apr 07 '22 at 11:07 — Waleed, Apr 07 '22 at 11:07

Saving Email Attachments automatically

1 Answers1