Consulting

Results 1 to 2 of 2

Thread: Run script on one of multiple email addresses

  1. #1

    Run script on one of multiple email addresses

    Hey there,

    I am running a script to print PDF attachments, which works very well.

    However, there are 2 email addresses in use (reception(at)someemail(dot)com and admin(at)someemail(dot)com)

    The script prints PDF attachments sent to either of the accounts, and I would like to just print PDF attachments sent to admin(at)someemail(dot)com

    The code that I am using is:

    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
      
      Private WithEvents Items As Outlook.Items
      
      Private Sub Application_Startup()
        Dim Ns As Outlook.NameSpace
        Dim Folder As Outlook.MAPIFolder
      
        Set Ns = Application.GetNamespace("MAPI")
        Set Folder = Ns.GetDefaultFolder(olFolderInbox)
        Set Items = Folder.Items
      End Sub
      
      Private Sub Items_ItemAdd(ByVal Item As Object)
        If TypeOf Item Is Outlook.MailItem Then
          PrintAttachments Item
        End If
      End Sub
      
      Public Sub PrintAttachments(oMail As Outlook.MailItem)
        On Error Resume Next
        Dim colAtts As Outlook.Attachments
        Dim oAtt As Outlook.Attachment
        Dim sFile As String
        Dim sDirectory As String
        Dim sFileType As String
      
        sDirectory = "C:\Temp_PDF_Print"
      
        Set colAtts = oMail.Attachments
      
        If colAtts.Count Then
          For Each oAtt In colAtts
      
            sFileType = LCase$(Right$(oAtt.FileName, 4))
      
            Select Case sFileType
            Case ".pdf"
    
              sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
              oAtt.SaveAsFile sFile
              ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
            End Select
          Next
        End If
      End Sub
    I suspect the issue is NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile, therefore printing all PDF attachments from both of the email addresses.

    How do I change this to only print PDF attachments sent to admin(at)someemail(dot)com?

    Any help is much appreciated.
    Thank you :-)

  2. #2
    I am not sure how it worked correctly when you had
     sDirectory = "C:\Temp_PDF_Print"
    'rather than
     sDirectory = "C:\Temp_PDF_Print\"
    'and
    sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
    The simplest approach to this is to use the script (slightly modified and in a normal module rather than ThisOutlookSession) to run from a rule that checks all incoming mail to admin(at)someemail(dot)com as it arrives in the inbox. If the Scripts option is missing from the rules, then see https://www.slipstick.com/outlook/ru...-script-rules/
    I would suggest creating the temporary file on the desktop then delete it after printing.
    The modified code also works on 64 bit Office.

    Option Explicit
    
    #If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
            ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
            ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr
    #Else
    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
    #End If
    
    
    Public Sub PrintAttachments(oMail As Outlook.MailItem)
        On Error Resume Next
        Dim colAtts As Outlook.Attachments
        Dim oAtt As Outlook.Attachment
        Dim sFile As String
        Dim sDirectory As String
        Dim sFileType As String
    
    
        If TypeName(oMail) = "MailItem" Then
            sDirectory = Environ("USERPROFILE") & "\Desktop\"
    
    
            Set colAtts = oMail.Attachments
            If colAtts.Count Then
                For Each oAtt In colAtts
                    sFileType = LCase$(Right$(oAtt.FileName, 4))
                    Select Case sFileType
                        Case ".pdf"
                            sFile = sDirectory & oAtt.FileName
                            oAtt.SaveAsFile sFile
                            ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                    End Select
                Next
            End If
        End If
        Set colAtts = Nothing
        Set oAtt = Nothing
        Set oMail = Nothing
    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
  •