Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 102
  • Last Modified:

How would I incorporate multiple scripts in my "ThisOutlookSession"?

I have a script that I had been using to prompt me to cc members of a group when sending an email.  I also have a script that runs based on the subject and saves the attached pdf file and moves the email to a specified folder.
How can I combine or configure them so they will both run without issues?
Scripts are attached.
outlook-script_Copy-Supv.txt
Outlook-script_Eriksen_SaveAtt.txt
0
Michael Spellman
Asked:
Michael Spellman
  • 2
1 Solution
 
omgangCommented:
Have you tried combining them?

I've combined the two; I had to add a couple of lines near the top but have indicated where for both.  This compiles in Outlook 2016.  It should work; let me know.
OM Gang

Option Explicit

Private WithEvents objInboxItems As Items

Public WithEvents m_Inspectors As Outlook.Inspectors
Public WithEvents m_Inspector As Outlook.Inspector
Public WithEvents myitem As Outlook.MailItem


'add this
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                   (ByVal hwnd As LongPtr, ByVal lpszOp As String, _
                    ByVal lpszFile As String, ByVal lpszParams As String, _
                    ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                    As LongPtr



Private Sub Application_Startup()
    Dim objNS As NameSpace
    
    Dim MyInbox As Outlook.Folder       '<---  add this
    
    Set objNS = Application.GetNamespace("MAPI")
    ' instantiate Items collections for folders we want to monitor
    Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
    Set MyInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set objNS = Nothing
    
    Set m_Inspectors = Application.Inspectors
    
End Sub

Private Sub Application_Quit()
    ' disassociate global objects declared WithEvents
    Set objInboxItems = Nothing
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    'On the next line, edit the path to the folder you want the messages moved to after processing
    Const TARGET_FOLDER = "name@company.com\inbox\folder name"
    Dim olItems As Items, _
        olItem As Object, _
        olAttachmentItem As Attachment, _
        olkFld As Outlook.MAPIFolder, _
        strInvoice As String, _
        strFileName As String, _
        strSaveFileName As String, _
        intIdx As Integer

    Set olkFld = OpenOutlookFolder(TARGET_FOLDER)
    Set olItems = objInboxItems.Restrict("[Unread] = True")
    For intIdx = olItems.Count To 1 Step -1
        Set olItem = olItems.Item(intIdx)
        If olItem.Class = olMail Then
            'Selected based on the subject you want to key on
            If InStr(1, olItem.Subject, "Eriksen | Invoice #", vbTextCompare) > 0 Then
                If olItem.Attachments.Count > 0 Then
                    strInvoice = Right(olItem, 6)
                    For Each olAttachmentItem In olItem.Attachments
                        strFileName = "Eriksen_Invoice_" & strInvoice
                        'Change the path on the next line to the path you want to save your attachments in
                        strSaveFileName = "H:\My Documents\3_Purchase_Card\TransactionsFY2016\Eriksen_Translations\" & strFileName & ".pdf"
                        olAttachmentItem.SaveAsFile strSaveFileName
                        ShellExecute 0&, "print", strSaveFileName, 0&, 0&, 0&
                    Next
                End If
                olItem.UnRead = False
                olItem.Save
                olItem.Move olkFld
            End If
        End If
    Next
End Sub

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function


Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
  Set m_Inspector = Inspector
End Sub
'
Private Sub m_Inspector_Activate()
On Error GoTo exiterr
'is this item a mail item
If Not m_Inspector.CurrentItem.Class = OlObjectClass.olMail Then
    Set m_Inspector = Nothing
    Exit Sub
Else
    Set myitem = m_Inspector.CurrentItem
End If
Exit Sub
exiterr:
Set m_Inspector = Nothing
Set myitem = Nothing
End Sub
Private Sub myitem_Send(Cancel As Boolean)
Dim msg As Integer
    msg = MsgBox("Do you want to CC the group?", vbYesNo + vbSystemModal, "CC?")
    If (msg = vbNo) Then ' no, then bail
        Set myitem = Nothing
        Exit Sub
    Else
        Dim ns As Outlook.NameSpace
        Dim Folder As Outlook.MAPIFolder
        Set ns = Outlook.GetNamespace("MAPI")
        Set Folder = ns.GetDefaultFolder(olFolderInbox)
        Dim objOutlookRecip As Outlook.Recipient
        Set objOutlookRecip = myitem.Recipients.Add("OPS_Supv")
        objOutlookRecip.Type = olCC
    ' Resolve each Recipient's name.
    For Each objOutlookRecip In myitem.Recipients
        objOutlookRecip.Resolve
    Next
    End If
End Sub

Open in new window

0
 
Michael SpellmanSupervisory Operations Support SpecialistAuthor Commented:
Thanks OMGang,

I was thinking of combining, but I wasn't sure if there was a method that retained them as separate items within the ThisOutlookSession.  My thinking was that if they could be kind of modular, I could more easily modify each as necessary over time w/o affecting the other.
I tried your combo and it works with the caveat provided by BlueDevil.
Thanks very much.
0
 
Michael SpellmanSupervisory Operations Support SpecialistAuthor Commented:
Thanks omgang.
This works.  I had duplicate application_startup() sections in my attempt at combining.
Appreciate it.
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now