Consulting

Results 1 to 4 of 4

Thread: Compiling Error/Auto Print Attachments

  1. #1

    Compiling Error/Auto Print Attachments

    Capture.JPG
    This code runs, and spits out the email and attachment, but keeps giving this error. Any help is appreciated.

    ' Script to run with an Outlook rule.
    ' Open Visual Basic window in Outlook,
    ' and paste the entirely of this script
    ' into the ThisOutlokkSession window
    ' Save the script and close=and=reopen
    ' Outlook to test.






    Sub AttachementPrint(Item As Outlook.MailItem)


    On Error GoTo OError


    ' This script finds the system's Temp folders,
    ' saves any attachments, and runs the Print
    ' command for that file.


    Dim oFS As FileSystemObject
    Dim sTempFolder As String
    Set oFS = New FilesSystemObject
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)


    cTmpFld = aTempFolder & "\OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)


    ' in the next few lines, you'll see an entry that says
    ' FileType = . This line gets the last 4
    ' characters of he file name, wich we'll use later.


    Dim oAtt As Attachements
    For Each oAtt In Item.Attachements
    FileName = oAtt.FileName
    FileType = LCase$(Right$(FileName, 4))
    FullFile = cTmpFld & "" & FileName
    oAtt.SaveAsFile (FullFile)


    ' We're using the FileType text. Note that it's the
    ' last 4 characters of the file name, wich is why
    ' - the period counts as the fourth character.
    ' Insert any file extensions you want printed.


    Select Case FileType
    Case ".pdf", ".xls", "xlsx", ".ppt", "pptx", ".doc", "docx"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.NameSpace(0)
    Set objFolderItem = objFolder.ParseName(FullFile)
    objFolderItem.InvokeVerbEx ("print")
    End Select
    Next oAtt


    'Cleanup
    If Not oFS Is Nothing Then Set oFS = Nothing
    If Not objFolder Is Nothing Then Set objFolder = Nothing
    If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
    If Not objShell Is Nothing Then Set objShell = Nothing


    OError:
    If Err <> 0 Then
    MsgBox Err.Number & " - " & Err.Description
    Err.Clear
    End If
    Exit Sub


    End Sub
    The best part of the work out? The End

  2. #2
    You can't make up your own syntax or spell command names incorrectly and expect it to work. Based on your code the following corrects the errors

    Sub AttachmentPrint(Item As Outlook.MailItem)
    Dim oFS As Object
    Dim sTempFolder As String
    Dim oAtt As Attachment
    Dim sFilename As String
    Dim sFileType As String
    Dim sFullFile As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
    
        On Error GoTo OError
        ' This script finds the system's Temp folders,
        ' saves any attachments, and runs the Print
        ' command for that file.
    
        Set oFS = CreateObject("Scripting.FileSystemObject")
        sTempFolder = oFS.GetSpecialFolder(TemporaryFolder) & "\OETMP" & Format(Now, "yyyymmddhhmmss") & "\"
    
       MkDir sTempFolder
    
        ' in the next few lines, you'll see an entry that says
        ' sFileType = . This line gets the last 4
        ' characters of the file name, which we'll use later.
    
        For Each oAtt In Item.Attachments
            sFilename = oAtt.fileName
            sFileType = LCase$(Right$(sFilename, 4))
            sFullFile = sTempFolder & sFilename
            oAtt.SaveAsFile sFullFile
    
            ' We're using the sFileType text. Note that it's the
            ' last 4 characters of the file name, wich is why
            ' - the period counts as the fourth character.
            ' Insert any file extensions you want printed.
    
            Select Case sFileType
                Case ".pdf", ".xls", "xlsx", ".ppt", "pptx", ".doc", "docx"
                    Set objShell = CreateObject("Shell.Application")
                    Set objFolder = objShell.NameSpace(0)
                    Set objFolderItem = objFolder.ParseName(sFullFile)
                    objFolderItem.InvokeVerbEx ("print")
            End Select
        Next oAtt
    
        'Cleanup
        If Not oFS Is Nothing Then Set oFS = Nothing
        If Not objFolder Is Nothing Then Set objFolder = Nothing
        If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
        If Not objShell Is Nothing Then Set objShell = Nothing
    
    OError:
        If Err <> 0 Then
            MsgBox Err.Number & " - " & Err.Description
            Err.Clear
        End If
        Exit Sub
    
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Capture1.JPG now it runs and I get this after
    The best part of the work out? The End

  4. #4
    The macro should go in an ordinary module (not ThisOutlookSession)
    The following revised version includes more error handling but both this and the previous version of the macro should both work. Use the test macro to test it on a message with attachments
    I suspect the problem is with your rule. I assume that you have scripts in rules enabled and that you have actually selected the name of the script in the rule.
    Option Explicit
    
    Sub Test()
    Dim olMsg As MailItem
        On Error Resume Next
        Select Case Outlook.Application.ActiveWindow.Class
            Case olInspector
                Set olMsg = ActiveInspector.currentItem
            Case olExplorer
                Set olMsg = Application.ActiveExplorer.Selection.Item(1)
        End Select
        AttachmentPrint olMsg
    lbl_exit:
        Exit Sub
    End Sub
    
    Sub AttachmentPrint(Item As Outlook.MailItem)
    Dim sTempFolder As String
    Dim oAtt As Attachment
    Dim sFilename As String
    Dim sFileType As String
    Dim sFullFile As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFolderItem As Object
    
        On Error GoTo OError
        ' This script finds the User's Temp folder,
        ' saves any attachments, and runs the Print
        ' command for that file.
    
        If Not TypeName(Item) = "MailItem" Then Exit Sub
        If Item.Attachments.Count = 0 Then Exit Sub
    
        sTempFolder = Environ("TEMP") & "\"
    
    
        ' in the next few lines, you'll see an entry that says
        ' sFileType = . This line gets the last 4
        ' characters of the file name, which we'll use later.
    
        For Each oAtt In Item.Attachments
            sFilename = oAtt.fileName
            sFileType = LCase$(Right$(sFilename, 4))
            sFullFile = sTempFolder & sFilename
            oAtt.SaveAsFile sFullFile
    
            ' We're using the sFileType text. Note that it's the
            ' last 4 characters of the file name, wich is why
            ' - the period counts as the fourth character.
            ' Insert any file extensions you want printed.
    
            Select Case sFileType
                Case ".pdf", ".xls", "xlsx", ".ppt", "pptx", ".doc", "docx"
                    Set objShell = CreateObject("Shell.Application")
                    Set objFolder = objShell.NameSpace(0)
                    Set objFolderItem = objFolder.ParseName(sFullFile)
                    objFolderItem.InvokeVerbEx ("print")
            End Select
        Next oAtt
    
    lbl_exit:
        'Cleanup
        If Not objFolder Is Nothing Then Set objFolder = Nothing
        If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
        If Not objShell Is Nothing Then Set objShell = Nothing
        Exit Sub
    OError:
        If Err <> 0 Then
            MsgBox Err.Number & " - " & Err.Description
            Err.Clear
        End If
        GoTo lbl_exit
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

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