Lightweight because half the useful functions are missing?
I don't know what its capability is, but the following will save the PDFs from a selected message to a named folder, which will be created if it doesn't exist.
Code:
Option Explicit
Sub GetPDFAttachments()
Dim olMsg As MailItem
'On Error Resume Next
Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olMsg = ActiveInspector.currentItem
Case olExplorer
Set olMsg = Application.ActiveExplorer.Selection.Item(1)
End Select
SaveAttachments olMsg
lbl_Exit:
Exit Sub
End Sub
Private Sub SaveAttachments(olItem As MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 26 May 2017
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim j As Long
Const strSaveFldr As String = "C:\Attachments\"
CreateFolders strSaveFldr
On Error Resume Next
If olItem.Attachments.Count > 0 Then
For j = 1 To olItem.Attachments.Count
Set olAttach = olItem.Attachments(j)
If olAttach.FileName Like "*.pdf" Then
strFname = olAttach.FileName
olAttach.SaveAsFile strSaveFldr & strFname
End If
Next j
olItem.Save
End If
lbl_Exit:
Set olAttach = Nothing
Set olItem = Nothing
Exit Sub
End Sub
Private Function FolderExists(fldr) As Boolean
'An Outlook macro by Graham Mayor
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If (FSO.FolderExists(fldr)) Then
FolderExists = True
Else
FolderExists = False
End If
lbl_Exit:
Exit Function
End Function
Private Function CreateFolders(strPath As String)
'An Outlook macro by Graham Mayor
Dim strTempPath As String
Dim lngPath As Long
Dim VPath As Variant
VPath = Split(strPath, "\")
strPath = VPath(0) & "\"
For lngPath = 1 To UBound(VPath)
strPath = strPath & VPath(lngPath) & "\"
If Not FolderExists(strPath) Then MkDir strPath
Next lngPath
lbl_Exit:
Exit Function
End Function