Thread: Outlook, print pdf Save Attachment, Move Email To A Subfolder

Hi Guys,

I think this can be done .............gere goes

we receive about 125 emails a week containing orders in pdf format.

what i am looking to do, is when the emails come in automatically print the pdf attachments, mark as read then move the emails to subfolders...

easy (NOT)

any help on this would be great...

cheers

stephen

Originally Posted by split_atom18

I have been toying with the exact same concept stephen, only adding saving the file to a folder on my computer on top of those things. If I figure it out I will be sure to post it here for you.

Check this post

It has helped me some.

Hi Split_atom18, i have seen this about, i manged to get the file attachments to save to HD

I will play about some more to see, have done similar things in excel and has worked a treat.

cheers

Hi Split,

Found this and got it to work

Code:

Option Explicit
Dim WithEvents TargetFolderItems As Outlook.Items
'Set FILE_PATH on the following line to the path you want to save the attachments to.  Make sure it ends with a \
Const FILE_PATH As String = "C:\temp\"
 
Private Sub Application_Startup()
    'Change the folder path on the line below to point to the folder you want to monitor
    Set TargetFolderItems = Session.Folders.Item("Personal Folders").Folders.Item("Inbox").Folders.Item("JLP").Items
End Sub
 
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
    'When a new item is added to our "watched folder" we can process it
    Dim olAttachment As Outlook.Attachment
    For Each olAttachment In Item.Attachments
        'Save the attachment
        olAttachment.SaveAsFile FILE_PATH & olAttachment.FileName
    Next
    Set olAttachment = Nothing
End Sub
 
Private Sub Application_Quit()
    Set TargetFolderItems = Nothing
End Sub

you need to paste it into This Outlook Session not a seperate module

Change the C:\temp\ to what ever on your hard drive also

Change 'Set TargetFolderItems = Session.Folders.Item("Personal Folders").Folders.Item("Inbox").Folders.Item("JLP").Items'

to wherever you move the files too..........

hope it makes sense


stephen

Hi Split,

also found a print macro, as a seperate code.

I was trying to run the two together not much succes yet

will keep posting as and when

cheers

Hey Split_Atom18

How you doin?

I have sort of cracked it with waht I need, I have seen some stuff you need dotted around the web after exstensive searches. I am posting what I have It mioght help

cheers
Stephen

Code:

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler

  Dim Msg As Outlook.MailItem
  Dim MsgAttachs As Outlook.Attachments
  Dim MsgAttach As Outlook.Attachment

  Dim tempFolder As String
  Dim attach As String
  Dim senderName As String
    
  

  ' if not a mailitem, exit
  If TypeName(item) <> "MailItem" Then GoTo ProgramExit

  Set Msg = item
  Set MsgAttachs = Msg.Attachments

  ' if no attachments, exit
  If MsgAttachs.Count = 0 Then GoTo ProgramExit

  ' find temp folder
  'tempFolder = Environ("temp") & PATH_SEPARATOR
    tempFolder = "C:\Users\stephen\Documents\New Folder (4)\New Folder\" '& MsgAttachs.fileName
            'MsgAttachs.SaveAsFile fileName
            'Shell """c:\program files\adobe\reader 8.0\reader\acrord32.exe"""
            'i = 1 + 1
             


  ' loop through attachments
  For Each MsgAttach In MsgAttachs
    If IsPDF(MsgAttach.fileName) Then  ' it's a PDF
      ' save it to temp folder
      MsgAttach.SaveAsFile tempFolder & MsgAttach.fileName
      ' print it
      Call PrintPDF(tempFolder & MsgAttach.fileName)

      ' mark the email as read and exit loop
      'Msg.UnRead = False
      Exit For

    End If
  Next MsgAttach
  
  ' move received email to target folder based on sender name
 senderName = Msg.senderName

  If CheckForFolder(senderName) = False Then  ' Folder doesn't exist
   Set targetFolder = CreateSubFolder(senderName)
  Else
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set targetFolder = _
    objNS.GetDefaultFolder(olFolderInbox).Folders(senderName)
  End If
  'Msg.UnRead = False
  Msg.Move targetFolder

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox err.number & " - " & err.Description
  Resume ProgramExit
End Sub
  
  Function CheckForFolder(strFolder As String) As Boolean
' looks for subfolder of specified folder, returns TRUE if folder exists.
  Dim olApp As Outlook.Application
  Dim olNS As Outlook.NameSpace
  Dim olInbox As Outlook.MAPIFolder
  Dim FolderToCheck As Outlook.MAPIFolder

  Set olApp = Outlook.Application
  Set olNS = olApp.GetNamespace("MAPI")
  Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

  ' try to set an object reference to specified folder
  On Error Resume Next
  Set FolderToCheck = olInbox.Folders(strFolder)
  On Error GoTo 0

  If Not FolderToCheck Is Nothing Then
    CheckForFolder = True
  End If

ExitProc:
  Set FolderToCheck = Nothing
  Set olInbox = Nothing
  Set olNS = Nothing
  Set olApp = Nothing
End Function

Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
' assumes folder doesn't exist, so only call if calling sub knows that
' the folder doesn't exist; returns a folder object to calling sub
  Dim olApp As Outlook.Application
  Dim olNS As Outlook.NameSpace
  Dim olInbox As Outlook.MAPIFolder

  Set olApp = Outlook.Application
  Set olNS = olApp.GetNamespace("MAPI")
  Set olInbox = olNS.GetDefaultFolder(olFolderInbox)

  Set CreateSubFolder = olInbox.Folders.Add(strFolder)

ExitProc:
  Set olInbox = Nothing
  Set olNS = Nothing
  Set olApp = Nothing
End Function

Function GetFileType(fileName As String) As String
' get file extension
  GetFileType = Mid$(fileName, InStrRev(fileName, ".") + 1, Len(fileName))

End Function

Function IsPDF(fileName As String) As Boolean
' returns True if file extension is "PDF  "
  IsPDF = (UCase$(GetFileType(fileName)) = "PDF")
End Function

Function PrintPDF(fileName As String)

 Shell """C:\Program Files\Adobe\reader 9.0\Reader\AcroRd32.exe"" /t """ _
                & fileName & """"
End Function