VBA script in outlook 2016/2019, that popup a dialog box to choose a folder in which the mail should be saved. (only when composing a new mail or replying to mail in inbox)

I have a script in outlook 2016/2019, that popup a dialog box to choose a folder in which the mail should be saved after I send the email.
This works good.

I have additional settings in the outlook that makes me "save the reply in the same folder".
save the reply in the same folder
Now I want that the dialog box (as per the script) should popup, only when I am not replying to a mail from a folder. (except inbox)
 i.e the dialog box to choose folder should popup, only when I am composing a new email or when I am replying to email from inbox.




http://www.outlookcode.com/article.aspx?id=48
Code source

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    On Error Resume Next
    Set objNS = Application.Session
    If Item.Class = olMail Then
        Set objFolder = objNS.PickFolder
        If Not objFolder Is Nothing And _
          IsInDefaultStore(objFolder) And _
          objFolder.DefaultItemType = olmailitem Then
            Set Item.SaveSentMessageFolder = objFolder
        Else
            Set objFolder = _
              objNS.GetDefaultFolder(olFolderSentMail)
            Set Item.SaveSentMessageFolder = objFolder
        End If
    End If
    Set objFolder = Nothing
    Set objNS = Nothing
End Sub

Public Function IsInDefaultStore(objOL As Object) As Boolean
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objInbox As Outlook.MAPIFolder
    Dim blnBadObject As Boolean
    On Error Resume Next
    Set objApp = objOL.Application
    If Err = 0 Then
        Set objNS = objApp.Session
        Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
        Select Case objOL.Class
            Case olFolder
                If objOL.StoreID = objInbox.StoreID Then
                    IsInDefaultStore = True
                Else
                    IsInDefaultStore = False
                End If
            Case olAppointment, olContact, olDistributionList, _
                 olJournal, olMail, olNote, olPost, olTask
                If objOL.Parent.StoreID = objInbox.StoreID Then
                    IsInDefaultStore = True
                Else
                    IsInDefaultStore = False
                End If
            Case Else
                blnBadObject = True
        End Select
    Else
        blnBadObject = True
    End If
    If blnBadObject Then
        MsgBox "This function isn't designed to work " & _
                "with " & TypeName(objOL) & _
                " objects and will return False.", _
                , "IsInDefaultStore"
        IsInDefaultStore = False
    End If
    Set objApp = Nothing
    Set objNS = Nothing
    Set objInbox = Nothing
End Function

Open in new window

LVL 2
Akash BansalIT ProfessionalAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Neil FlemingConsultant and developerCommented:
I think the code below does what you want. It is a rework of what you have with some extra functions.

The trick is to detect when a message being sent is a reply. Outlook does not make this easy, because the built-in "_onreply" routine is only triggered if you reply from an "inspector" object.. ie when you have opened the mail item you want to reply to. If you are replying from the preview pane, this leaves you high and dry.

Fortunately, the "conversationindex" property of an item being sent appears to be a reliable guide to whether it is a reply or not. See function isReply below. I am not 100% sure this is infallible, but has worked so far in testing.. New mail items have a conversationindex length of 44 characters. Anything longer is a reply.

In addition, of course, you have to track what item is currently selected in the outlook explorer, in order to check if it's in a folder other than the Inbox.

I THINK my code does what you want: namely prompts for a save folder if the email is a NEW item, or if it is a REPLY to an item in the INBOX.

The code needs to go in the ThisOutlookSession code module, of course, replacing your existing code (please make a backup!) And you need to restart Outlook.

Hope this helps.

Option Explicit

Public mainInbox As Folder, CurrentFolder As Folder, SentFolder As Folder, saveFolder As Folder
Public WithEvents oExp As Explorer
Public WithEvents oNS As Outlook.NameSpace
Public WithEvents CurrentItem As MailItem


Private Sub Application_Startup()
DoEvents
Set mainInbox = Session.GetDefaultFolder(olFolderInbox)
Set SentFolder = Session.GetDefaultFolder(olFolderSentMail)
Set oExp = Application.ActiveExplorer
Set oNS = Application.GetNamespace("MAPI")
Debug.Print "started"
End Sub

Sub SetupDefaults()
' this is a backup for application startup.. created so I could debug without restarting outlook
Set mainInbox = Session.GetDefaultFolder(olFolderInbox)
Set SentFolder = Session.GetDefaultFolder(olFolderSentMail)
Set oExp = Application.ActiveExplorer
Set oNS = Application.GetNamespace("MAPI")
DoEvents
oExp_SelectionChange
Debug.Print "re-started defaults"
End Sub

Private Sub oExp_SelectionChange()
   'records the current folder of any item selected, provided it is a mailItem
   'on error statement prevents failure if selected item is not a mail item
   On Error Resume Next
   Err.Clear
   Set CurrentItem = oExp.Selection.Item(1)
   'get item folder
   If Err.Number = 0 Then
   Set CurrentFolder = CurrentItem.parent
   End If
End Sub



Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    
    Dim bAsk As Boolean
    On Error Resume Next
    ' in case default folders and item explorer etc are lost (helps debugging)
    If (mainInbox Is Nothing) Then SetupDefaults
    
    If Item.Class = olMail Then
    'set save location to current folder of item being replied to by default
    Set Item.SaveSentMessageFolder = CurrentFolder
    'ask for folder by default (assuming new email)
    bAsk = True
    'check if message is a reply
    'Then only ask for folder selection if replying to a main inbox message
    If IsReply(Item) Then bAsk = CurrentFolder.Name = mainInbox.Name
    
        If bAsk Then
        'call askforFolder function
          'loop request until you have a valid save folder
            While (saveFolder Is Nothing)
            Set saveFolder = AskForFolder
                If (Not (saveFolder Is Nothing)) Then
                Set Item.SaveSentMessageFolder = saveFolder
                Else
                    If MsgBox("Not a valid folder to save in. Hit OK to try again or Cancel to save in Sent Items", vbOKCancel) = vbCancel Then
                   'if user hits cancel, reply will be saved in the default Outlook Sent Items folder
                    Set saveFolder = SentFolder
                    Set Item.SaveSentMessageFolder = SentFolder
                    End If
                End If
            Wend
        End If
    End If
Set saveFolder = Nothing
End Sub

Function AskForFolder() As Folder
Dim ff As Folder
Set ff = oNS.PickFolder
If Not ff Is Nothing Then
    If (IsInDefaultStore(ff)) And (ff.DefaultItemType = olMailItem) Then
    Set AskForFolder = ff
    End If
End If

End Function

Function IsReply(oItem As MailItem)

'new emails have a conversation index length of 44. Replies have a longer index:
If Len(oItem.ConversationIndex) > 44 Then IsReply = True

End Function


Public Function IsInDefaultStore(objOL As Object) As Boolean
    'simplified this because inbox folder, oNS etc already set in application_start
    ' no need for "else" statements setting IsInDefaultStore to false, since this will be false by default
    Dim blnBadObject As Boolean
    On Error Resume Next
        Select Case objOL.Class
            Case olFolder
                If objOL.StoreID = mainInbox.StoreID Then IsInDefaultStore = True
            Case olAppointment, olContact, olDistributionList, _
                 olJournal, olMail, olNote, olPost, olTask
                If objOL.parent.StoreID = mainInbox.StoreID Then IsInDefaultStore = True
            Case Else
                blnBadObject = True
        End Select
    
    If blnBadObject Then
        MsgBox "This function isn't designed to work " & _
                "with " & TypeName(objOL) & _
                " objects and will return False.", _
                , "IsInDefaultStore"
        IsInDefaultStore = False
    End If
    
End Function

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Akash BansalIT ProfessionalAuthor Commented:
I am overwhelmed. You came up with the code exactly I was looking for.
I have no words to thank you for this.
It worked as a charm. :)

No body attempted to suggest anything except you. Total views were 14!
Cheers!
Neil FlemingConsultant and developerCommented:
My pleasure. I am still a bit worried about whether the "isReply" function  works under all circumstances. But if it fails the code will simply prompt you for a folder when you would rather it didn't...
Akash BansalIT ProfessionalAuthor Commented:
I tested as per my requirement & the way I use outlook; it worked perfectly.
If I find any exception, I would update you here.
Thanks again. :)
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.