Avatar of kafrin_1
kafrin_1Flag for Australia asked on

How to autoprint files in outlook using visual basic

Currently I'm using the following line to print pdfs from an outlook 2003 macro:
Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + Filename + """", vbHide

I wish to be able to print any type of file - eg doc, dwg, xls etc.
If anyone knows a generic command, or list of standard commands to do this, i would be most appreciative. thank you.

I have ms office 2003, vista, adobe8
Outlook

Avatar of undefined
Last Comment
kafrin_1

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Rob132332

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
ASKER
kafrin_1

worked perfectly! cheers.

For anyone else who needs to do the same thing as me:

Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub PrintAttachments()

    'Declaration
    Dim myItems, myItem, MyAttachments, myAttachment As Object
    Dim myOrt As String
    Dim printfiletype As String
    'Dim myOlApp As New
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim MyAttachmentName As String
    'Ask for destination folder
         'Dim myItem As Outlook.Inspector
    Dim Filename As String
    Dim objItem As Object
    Set myOlApp = CreateObject("Outlook.Application")
    Set myItem = myOlApp.ActiveInspector
     'savefiletype = InputBox("What file type do you wish to save?", "Save Attachments", "all")
   
     
        'Set objItem = myItem.CurrentItem
        esubject = myItem
        'Prompt the user for confirmation
        Dim strPrompt As String
        Dim JNum As String
        Dim j As Integer
       
        Dim Filetype As String
        ' restructure string name to get rid of formatting
         
        esubject = Replace(esubject, ":", "")
        esubject = Replace(esubject, ".", "")
        esubject = Replace(esubject, "/", "")
        esubject = Replace(esubject, "!", "")
        esubject = Replace(esubject, ",", "")
        esubject = Replace(esubject, "'", "")
        esubject = Replace(esubject, "(", "")
        esubject = Replace(esubject, ")", "")
        esubject = Replace(esubject, "?", "")
        esubject = Replace(esubject, "*", "")
        esubject = Replace(esubject, " ", "_")
        esubject = Replace(esubject, Chr(34), "")
        esubject = Replace(esubject, Chr(9), "")
        esubject = Mid(esubject, 1, 40)
       
        If esubject = "" Then
        esubject = "untitled"
        End If
       
        ' check for job number
         JNum = Replace(esubject, " ", "")
     
        For j = 32 To 255 ' get rid of everything except 6 numbers
        If j <= 47 Or j >= 58 Then
        JNum = Replace(JNum, Chr(j), "")
        End If
      Next j
                       
      JNum = Left(JNum, 6)
      'JNum is less than 6 digits, ask the user to enter the job number for a particular subject of an email
       j = 10
       If Len(JNum) < 6 Then
          j = 2000
          JNum = InputBox("Enter Job Number:", "No Job Number Found for this email", "")
         
       End If
       
   
    'work on selected items
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
   
    'for all items do...
    For Each myItem In myOlSel 'My Item = subject
   
        'point on attachments
        Set MyAttachments = myItem.Attachments
       
        'if there are some...
        If MyAttachments.Count > 0 Then
        printfiletype = InputBox("What file type do you wish to print (PDF ONLY)?", "Print Attachments", "pdf")
        printfiletype = Replace(printfiletype, Chr(34), "")
       
       
        On Error Resume Next
           
            'add remark to message text
            'myItem.Body = myItem.Body & vbCrLf & _
                "Removed Attachments:" & vbCrLf
               
           
'for all attachments do...
            j = 0
            For i = 1 To MyAttachments.Count '1:#atmts' 'Myattachments(i) = attachment filename
            Filetype = Right(MyAttachments(i), 3)
            If Filetype = printfiletype Or printfiletype = "all" Then
           
           
           
           
           
           
      '      MyAttachments(i) = JNum & "_" & Format(myItem.CreationTime, "yyyymmdd_hhnnss_") & "_" & MyAttachments(i)
                'save them to destination
        '        MyAttachments(i).SaveAsFile myOrt & _
        '            MyAttachments(i).DisplayName

                'add name and destination to message text
       '         myItem.Body = myItem.Body & _
        '            "File: " & myOrt & _
        '            MyAttachments(i).DisplayName & vbCrLf
       
              If Right(MyAttachments(i), 3) = "pdf" Then
              ' This path must exist! Change folder name as necessary.
               
               Filename = "C:\Temp\ab" & _
                               Format(myItem.CreationTime, "yyyymmdd_hhnnss_") & JNum & "_" & MyAttachments(i) 'creation time is more accurate/appropriate that recieved time
                     
                MyAttachments(i).SaveAsFile Filename
                 'all attachments are first saved in the temp folder C:Temp.  Be sure to create this folder.
           
            'please change the program folder accordingly if the Acrobat Reader is not installed on drive C:
                Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + Filename + """", vbHide
                j = j + 1
               
                Else
               
                Filename = "C:\Temp\ab" & _
                               Format(myItem.CreationTime, "yyyymmdd_hhnnss_") & JNum & "_" & MyAttachments(i)
                MyAttachments(i).SaveAsFile Filename
                ShellExecute 0&, "print", Filename, 0&, 0&, 0&
                Kill Filename
                j = j + 1
                End If
       
       
       
            End If
            Next i
           
            'for all attachments do...
            'While myAttachments.Count > 0
           
                ''remove it (use this method in Outlook XP)
                ''myAttachments.Remove 1
               
               ' 'remove it (use this method in Outlook 2000)
              '  myAttachments(1).Delete
               
            'Wend
           
            'save item without attachments
            'myItem.Save
        End If
       
       
    Next
   
    If j = 0 Then
    MsgBox "There were no printable attachments for this email"
    ElseIf j = 1 Then
    MsgBox "There was " & j & " attachment printed to your default printer."
    Else
    MsgBox "There were " & j & " attachments printed to your default printer."
    End If
   
    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set MyAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing 'outlook
    Set myOlExp = Nothing
    Set myOlSel = Nothing
   
End Sub
Your help has saved me hundreds of hours of internet surfing.
fblack61