Outlook 2016 - save multiple attachments at once to network drive - not possible

this is the vba code :

you can adjust the inbox map print in this source in whatever you want.

================================================

Option Explicit
Dim WithEvents TargetFolderItems As Items

Const FILE_PATH As String = "C:\Temp2\"  'you have to create this map on your c-drive

'Private Declare Function ShellExecute Lib "shell32.dll" Alias _

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Private Sub Application_Startup()

    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem

    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set olFolder = olFolder.Folders("print") ' map inside the inbox

    Set TargetFolderItems = olFolder.Items

End Sub


Sub TargetFolderItems_ItemAdd(ByVal Item As Object)

On Error Resume Next
    Dim colAtts As Outlook.Attachments
    Dim oAtt As Outlook.Attachment
    Dim sFile As String
    Dim sDirectory As String
    Dim sFileType As String

Set colAtts = Item.Attachments

If colAtts.Count Then
    For Each oAtt In colAtts


Dim pos As Long
pos = Len((oAtt.FileName)) - InStr(1, oAtt.FileName, ".", vbTextCompare) + 1

sFileType = LCase$(Right$(oAtt.FileName, pos))

Select Case sFileType

    Case ".prt"
          
            sFile = FILE_PATH & oAtt.FileName
            sFile = Replace(sFile, " ", "")  ' remove spaces from file
            oAtt.SaveAsFile sFile & ".doc"
                      

    Case ".xlsx", ".docx", ".pdf", ".doc", ".xls"
           
            sFile = FILE_PATH & oAtt.FileName
            sFile = Replace(sFile, " ", "")
            oAtt.SaveAsFile sFile
        
            
    End Select
        Next
End If

End Sub


Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub

================ end vba code =============================
this is the vbs script, you have to place inside the temp2 directory, see vba code above for directory
============= start of vbs script ==============================

Dim objOffice, oWkbk, strFile


If WScript.Arguments.Count = 0 Then
  ' no arguments passed from command line  
  WScript.Quit
Else
  strFile = Wscript.Arguments(0)

  ' Print XLS document
  If (Right(strFile, 3) = "xls") Then
    Set objOffice = CreateObject("Excel.Application")
    objOffice.Visible = False
    Set oWkbk = objOffice.Workbooks.Open(strFile)
    oWkbk.PrintOut
    oWkbk.Close xlDoNotSaveChanges
    objOffice.Quit
  End If

 ' Print XLS document
  If (Right(strFile, 4) = "xlsx") Then
    Set objOffice = CreateObject("Excel.Application")
    objOffice.Visible = False
    Set oWkbk = objOffice.Workbooks.Open(strFile)
    oWkbk.PrintOut
    oWkbk.Close xlDoNotSaveChanges
    objOffice.Quit
  End If

  ' Print WORD document
  If (Right(strFile, 4) = "docx") Then
    Set objOffice = WScript.CreateObject("Word.Application")
    objOffice.Documents.Open strFile
    objOffice.ActiveDocument.PrintOut
    Wscript.Sleep(1000)
    objOffice.ActiveDocument.Close
    objOffice.Quit
  End If

' Print WORD document
  If (Right(strFile, 3) = "doc") Then
    Set objOffice = WScript.CreateObject("Word.Application")
   ' objOffice.Documents.Open strFile
    objOffice.Documents.Open strFile
    objOffice.ActiveDocument.PrintOut
    Wscript.Sleep(1000)
    objOffice.ActiveDocument.Close
    objOffice.Quit
  End If

If (Right(strFile, 3) = "pdf") Then
    Set sh = CreateObject("WScript.Shell")
    sh.Run """Acrobat.exe"" /p /h"&strFile,,true
    Wscript.Sleep(1000)
  End If

End If

====== end of vbs script==  put this file inside the temp2 dir ================

the 3d file is a vb net application i wrote, if needed send me a p.m. , or you can make a cmd file yourself for executing the vbs script file.

good luck

solution exist at 3 parts

the vba outlook code

the vbscript code for printing the attachments

and a small vb net program for checking and printing the attachments at a specific time

if people needs help, i can assist with this,  email me at: patrick@vdhelm.com