automatically print e-mail attachments

<SCRIPT LANGUAGE="VBScript">

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

Stm = bstrURLItem
set WshShell = CreateObject("WScript.Shell")
strrun = WshShell.run ("c:\evtsink\auprint.vbs " & stm)
set WshShell = nothing
End Sub

</SCRIPT>


Main Script Auprint.vbs

set wshshell = Wscript.createobject("Wscript.Shell")
Set objArgs = WScript.Arguments
For I = 0 to objArgs.Count - 1
   if I = 0 then
     inbstr = objArgs(I)
   else
     inbstr = inbstr & " " & objArgs(I)
   end if
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set msgobj = CreateObject("CDO.Message")
msgobj.DataSource.Open inbstr, ,3
fname = int((90000000 * Rnd) + 1)     ' This generates a random number for the file name
fname = "c:\temp\" & fname & ".txt"
set wfile =  fso.opentextfile(fname,2,true)
REm Print Mail Header to file
wfile.writeline "*********************************************************************"
wfile.writeline "Email arrived From: " & msgobj.Fields("urn:schemas:httpmail:fromname")
wfile.writeline "Email Address: " & msgobj.Fields("urn:schemas:httpmail:fromemail")
wfile.Writeline "Email Recived At: " & msgobj.Fields("urn:schemas:httpmail:datereceived")
wfile.Writeline "Subject:  " & msgobj.Subject
wfile.writeline "*********************************************************************"
wfile.write msgobj.textbody
comex = "notepad.exe /p " & fname
strrun = WshShell.run (comex,1,TRUE)
wfile.close
fso.deletefile(fname)
set msgobj = nothing



that should werk, thank google ;)
found that this morning

Mikeal

thanks for the response... I will try these out tomorrow and give points to the one that works the best... stefri, what about PDF files? I will be receiving a large number of those...

I have to dig in Acrobat API for these....

Also noticed that I forget to print the current incoming mail:
insert this:

Item.printout

after set fso=nothing if you want to print only mails

before end sub if you want to print whatever you receive: Appointements, tasks, etc....

stefri,
I will give you more points if you can get it to print PDF documents as well.

Mikealcl,
As far as I can tell, the script that you gave is to be used only with Microsoft Exchange Server... am I wrong?

stefri,

Your method does not seem to be working.  I went into the VB editor in Outlook (XP) and pasted it into ThisOutlookSession.  I sent a test message to myself with an attachment of a Word document.  I receive the attachment into my inbox but nothing else happens.  Is there something else I need to do?

stefri,

Your method does not seem to be working.  I went into the VB editor in Outlook (XP) and pasted it into ThisOutlookSession.  I sent a test message to myself with an attachment of a Word document.  I receive the attachment into my inbox but nothing else happens.  Is there something else I need to do?

When you say did not work....does it man you pasted it directly in an opened Outlook and tested it?
If yes, you have to simulate a start Application in such a way events are registered;
Go to vba, then insert the cursor at:
Set objNS = Application.GetNamespace("MAPI")
then F8 until you exit the procedure

or Quit Outlook accepting to change the Microsoft Outlook Project

You also have to set macro security to medium
Tools/Macro/Security, select Medium
Restart Outlook and accept macro to be started.

If, after those steps, it still does not work, then I will be voiceless
Tested it yesterday while writing on OL2000

Stefri

Ah... I'm sorry about that. I should have realized I needed to restart Outlook first.

What about PDF documents? Have you gotten anywhere with that? I have plenty of points to give you if you can do it for me.

Thanks for your help so far.

Add after Dim olPpt as Object


Add this before Case else
Dim wshShell as Object
Dim cmdLine as String
Dim strRun as String

Add this before Case Else

            Case "pdf"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName

                Set wshShell = Application.CreateObject("Wscript.Shell")
                cmdLine = "Acrobat.exe /p /h " & myTempFolder & "\" & objAtt.DisplayName
                strRun = wshShell.run(cmdLine, 1, True)
                wshShell.Quit
                Set wshShell = Nothing
           case "txt"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName

                Set wshShell = Application.CreateObject("Wscript.Shell")
                cmdLine = "notepad.exe /p " & myTempFolder & "\" & objAtt.DisplayName
                strRun = wshShell.run(cmdLine, 1, True)
                wshShell.Quit
                Set wshShell = Nothing

If you need the complete code in one piece let me know
Stefri
PS: you obviously need Acrobat Reader installed on your machine....
I have also added txt printing

Oops...
Musr read:
Add after Dim olPpt as Object
Dim wshShell as Object
Dim cmdLine as String
Dim strRun as String

Add this before Case else

           Case "pdf"

Okay.  I had to change the filename from Acrobat.exe to Acrord32.exe but after that it worked great! This is exactly what I wanted.  Thank you very much.

I made a new question with some more points for you here:

https://www.experts-exchange.com/questions/20471733/for-stefri-only.html

Just post a comment and I will accept it.

Thanks again!

great code stefri

Happy you like it.
Where you looking for something special overthere?

no thanks

just answered the save attachment from email question when i saw the print attachment one and got stuck on the file extensions so just subscribed to the thread to see this from you pop up :)

Hi Stefri,
I am trying to do the exact same thing as polaughlin. Is it possible to send the whole code through as I seem to be having problems with the additions that you made and where to place them.
Thanks
Dave

Dave
Sorry I did not come often overhere, hope it is still needed

Option Explicit
 Dim objNS As NameSpace

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
 
  Set objNS = Application.GetNamespace("MAPI")
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Application_Quit()
    Set olInboxItems = Nothing
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strProgExt As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim i As Integer
Dim strExt As String
Dim fso As Object
Dim tempFolder As Object, myTempFolder As Object
Dim tempName As String
 
Dim olDocApp As Object
Dim olDoc As Object
Dim olXlsApp As Object
Dim olXls As Object
Dim olPptApp As Object
Dim olPpt As Object
Dim wshShell as Object
Dim cmdLine as String
Dim strRun as String
 
  On Error Resume Next
If Item.Class = olMail Then
  Set fso = Application.CreateObject("Scripting.FileSystemObject")
  If Err.Number <> 0 Then
      Err.Clear
      MsgBox "Need to have WSH installed on your machine.", vbOK, "Error: Scrpting missing"
      Set fso = Nothing

      Exit Sub
  Else
      Set tempFolder = fso.GetSpecialFolder(2) 'TempFolder
      tempName = tempFolder & "\" & fso.GetTempName
      Set myTempFolder = fso.CreateFolder(tempName)
      For Each objAtt In Item.Attachments
        intPos = InStrRev(objAtt.FileName, ".")
        strExt = LCase(Mid(objAtt.FileName, intPos + 1))
        Select Case strExt
            Case "doc"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olDocApp = Application.CreateObject("Word.Application")
                Set olDoc = olDocApp.Documents.Open(myTempFolder & "\" & objAtt.DisplayName)
                olDoc.PrintOut
                olDoc.Close 0
                olDocApp.Quit
                Set olDocApp = Nothing
            Case "xls"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olXlsApp = Application.CreateObject("Excel.Application")
                Set olXls = olXlsApp.Workbooks.Open(myTempFolder & "\" & objAtt.DisplayName)
                olXls.PrintOut
                olXls.Close 0
                Set olXls = Nothing
                olXlsApp.Quit
                Set olXlsApp = Nothing
            Case "ppt"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olPptApp = Application.CreateObject("Powerpoint.Application")
                Set olPpt = olPptApp.Presentations.Open(myTempFolder & "\" & objAtt.DisplayName)
                olPpt.PrintOut
                olPpt.Close 0
                Set olPpt = Nothing
                olPptApp.Quit
                Set olPptApp = Nothing
            Case "pdf"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName

                Set wshShell = Application.CreateObject("Wscript.Shell")
                cmdLine = " Acrord32.exe /p /h " & myTempFolder & "\" & objAtt.DisplayName
                strRun = wshShell.run(cmdLine, 1, True)
                wshShell.Quit
                Set wshShell = Nothing
           case "txt"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName

                Set wshShell = Application.CreateObject("Wscript.Shell")
                cmdLine = "notepad.exe /p " & myTempFolder & "\" & objAtt.DisplayName
                strRun = wshShell.run(cmdLine, 1, True)
                wshShell.Quit
                Set wshShell = Nothing
            Case Else
   
            End Select
        Set objAtt = Nothing
        Next

    Set tempFolder = Nothing
    fso.deleteFolder myTempFolder
    Set fso = Nothing
Item.printout
  End If
End If

End Sub
'<<<<< snip >>>>>