Solved

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

Posted on 2016-08-23
3
62 Views
Last Modified: 2016-08-23
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
Comment
Question by:Michael Spellman
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 28

Accepted Solution

by:
omgang earned 500 total points
ID: 41767735
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
 

Author Comment

by:Michael Spellman
ID: 41768000
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
 

Author Closing Comment

by:Michael Spellman
ID: 41768004
Thanks omgang.
This works.  I had duplicate application_startup() sections in my attempt at combining.
Appreciate it.
0

Featured Post

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Network Data Opinions 8 61
Add a second combobox VBA Excel 8 35
Office 365 Resource Calendars aka "Rooms" 4 42
Environment Variable Outlook 2 23
Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question