Results 1 to 2 of 2

Thread: Saving, renaming and printing pdf attachments in Outlook

  1. #1
    VBAX Newbie
    Joined
    Jul 2008
    Posts
    1
    Location

    Saving, renaming and printing pdf attachments in Outlook

    I'm writing some code that saves, renames and prints pdf attachments from a monitored folder.

    I've been looking at some code from Javavibe (which is a combination of Killian's KB 522 & Acrobat command line code from Masaru Kaji) which I've played around with:

    [vba]'########################################################################## #####
    '### Module level Declarations
    'expose the items in the target folder to events
    Option Explicit
    Dim WithEvents TargetFolderItems As Items
    'set the string constant for the path to save attachments
    Const FILE_PATH As String = "P:\Test\"

    '########################################################################## #####
    '### this is the Application_Startup event code in the ThisOutlookSession module
    Private Sub Application_Startup()
    'some startup code to set our "event-sensitive" items collection
    Dim ns As Outlook.NameSpace
    Dim Inbox As MAPIFolder

    Set ns = Application.GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox).Folders("Assessments")
    Set TargetFolderItems = Inbox.Items

    End Sub

    '########################################################################## #####
    '### this is the ItemAdd event code
    Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
    'when a new item is added to our "watched folder" we can process it
    Dim olAtt As Attachment
    Dim i As Integer
    Dim FileName As String

    If Item.Attachments.Count > 0 Then
    For i = 1 To Item.Attachments.Count
    Set olAtt = Item.Attachments(i)
    'rename file if attachment is pdf
    'If UCase(Right(olAtt.FileName, 3)) = "pdf" Then
    FileName = olAtt.FileName
    FileName = Mid(FileName, 7, 8) & ".pdf"
    'save the attachment if pdf
    olAtt.SaveAsFile FILE_PATH & FileName
    PrintAtt (FILE_PATH & FileName)
    Next
    End If

    Set olAtt = Nothing

    End Sub

    '########################################################################## #####
    '### this is the Application_Quit event code in the ThisOutlookSession module
    Private Sub Application_Quit()

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

    End Sub
    '########################################################################## #####
    '### print routine
    Sub PrintAtt(fFullPath As String)
    PrintPDF2 (fFullPath), 1
    End Sub
    Sub PrintPDF2(ByVal FileName As String, Optional Copies As Long = 1)
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '++ Prints the PDF files using a command line.
    '++ Written by Masaru Kaji aka Colo
    '++ Syntax
    '++ FileName : Required String expression that specifies a file name
    '++ - may include directory or folder, and drive..
    '++ Copies : Optional Long. The number of copies to print.
    '++ If omitted one copy is printed.
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Dim cnt As Long
    Dim myShell
    Set myShell = CreateObject("WScript.Shell")
    Dim Acro As AcroApp
    Set Acro = New AcroApp

    For cnt = 1 To Copies
    'opens Acrobat and prints file
    myShell.Run ("C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe/p" & FileName)
    Next
    'tidy up
    Acro.Exit
    End Sub
    [/vba]
    The code works perfectly up until it tries to print the PDF. It fails at the line:
    [vba]Set Acro = New AcroApp[/vba] with the error: Runtime error '429' ActiveX component can't create object.

    I have also tried this code, which was suggested has been suggested by Killian previously:[vba] Sub PrintAtt(file As String)
    'set a reference (Tools>References) to Adobe Acrobat type library

    Dim AcroApp As CAcroApp
    Dim AVDoc As CAcroAVDoc
    Dim PDDoc As CAcroPDDoc
    Dim NumPages As Long

    Set AcroApp = CreateObject("AcroExch.App")
    Set AVDoc = CreateObject("AcroExch.AVDoc")

    AVDoc.Open file, ""
    Set PDDoc = AVDoc.GetPDDoc
    NumPages = PDDoc.GetNumPages

    AcroApp.Show
    AVDoc.PrintPages 0, NumPages, 1, True, True[/vba] which fails at [vba]Set AcroApp = CreateObject("AcroExch.App")[/vba] with the error message being: Runtime error '-214722105 (800401f3) The Operation Failed.

    Does anyone have any idea what I'm doing wrong? I have referenced the Adobe Acrobat 8.0 type Library.

    Any help would be appreciated,
    Stephen

  2. #2

    I would like to save a pdf attachment to a network folder

    What is the easiest way to save the pdf attachment to a network folder

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •