Advertisement
adamchilcott

autoAttachmentPrinting.vbs

Nov 21st, 2018
435
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub LSPrint(Item As Outlook.MailItem)  
  2.     On Error GoTo OError
  3.      
  4.     'detect Temp
  5.    Dim oFS As FileSystemObject
  6.     Dim sTempFolder As String
  7.     Set oFS = New FileSystemObject
  8.     'Temporary Folder Path
  9.    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
  10.    
  11.     'creates a special temp folder
  12.    cTmpFld = sTempFolder & "\OETMP" & Format(Now, "yyyymmddhhmmss")
  13.     MkDir (cTmpFld)
  14.    
  15.     'save & print
  16.    Dim oAtt As Attachment
  17.     For Each oAtt In Item.Attachments
  18.       FileName = oAtt.FileName
  19.       FullFile = cTmpFld & "\" & FileName
  20.      
  21.       'save attachment
  22.      oAtt.SaveAsFile (FullFile)
  23.      
  24.       'prints attachment
  25.      Set objShell = CreateObject("Shell.Application")
  26.       Set objFolder = objShell.NameSpace(0)
  27.       Set objFolderItem = objFolder.ParseName(FullFile)
  28.       objFolderItem.InvokeVerbEx ("print")
  29.  
  30.     Next oAtt
  31.    
  32.     'Cleanup
  33.    If Not oFS Is Nothing Then Set oFS = Nothing
  34.     If Not objFolder Is Nothing Then Set objFolder = Nothing
  35.     If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
  36.     If Not objShell Is Nothing Then Set objShell = Nothing
  37.    
  38.   OError:
  39.     If Err <> 0 Then
  40.       MsgBox Err.Number & " - " & Err.Description
  41.       Err.Clear
  42.     End If
  43.     Exit Sub
  44.  
  45.   End Sub
  46.  
  47.   ' START NOTES
  48.  
  49.   ' Add the following code to "ThisOutlookSession" module.
  50.  ' Then create a rule for all incoming messages from a certain person
  51.  ' and choose run a script action.
  52.  
  53.   ' END NOTES
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement