Skip to content

Instantly share code, notes, and snippets.

Last active January 15, 2020 14:30
Show Gist options
  • Save gioxx/9214a6cc289a53cb80d6574e378b0360 to your computer and use it in GitHub Desktop.
Save gioxx/9214a6cc289a53cb80d6574e378b0360 to your computer and use it in GitHub Desktop.
La funzione permette di scaricare automaticamente uno o più file PDF allegati a una mail in ingresso in Outlook 2016. Consulta il blog per maggiori informazioni:
Attribute VB_Name = "SavePDFRule"
' Outlook 2016: Save all PDF Attachments
' -----------------------------------------------------------------------------------------------------------
' Author: GSolone
' Version: 0.3
' Based on: "Run a Script Rule to Save Attachments"
' (
' Last modified: 15-01-2020
' Credits:
' ------------------------------------------------------------------------------------------------------------
' 0.3- Fixed Item.ReceivedTime and dtDateRule problem (Runtime error 91 or 424)
' 0.2- I prepend SentOn (Date) to attachments, to solve the problem of the attachments with the same file name.
Public Sub SaveAttachments(Item As Outlook.MailItem)
If Item.Attachments.Count > 0 Then
Dim objOL As Outlook.Application
Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim strFile As String
Dim sFileType As String
Dim i As Long
Dim dtDateRule As Date
Dim sNameRule As String
Set objAttachments = Item.Attachments
lngCount = objAttachments.Count
For i = lngCount To 1 Step -1
dtDateRule = Item.ReceivedTime
sNameRule = Format(dtDateRule, "ddmmyyyy", vbUseSystemDayOfWeek, vbUseSystem) & "_" & Format(dtDateRule, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "-"
' Get the file name.
strFile = sNameRule & objAttachments.Item(i).FileName
' Get the path to your Desktop folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(10)
strFolderpath = strFolderpath & "\Attachments\"
' Create directory Attachments if not exist
If Dir(strFolderpath, vbDirectory) = "" Then
MkDir strFolderpath
End If
' Save the file only if is a PDF
If InStr(strFile, ".pdf") Then
' Combine with the path to the folder.
strFile = strFolderpath & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
End If
Next i
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment