Compiling Error/Auto Print Attachments

Attachment 26815
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

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

Code:

---

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

---

Attachment 26817http://www.vbaexpress.com/forum/imag...AAAElFTkSuQmCC now it runs and I get this after

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.

Code:

---

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

---