Outlook VBA Question about saving to second Mailbox

Can you provide your code for the function get folder?

Chris

Chris thank you for the reply.

I used the built-in function GetFolder to look at the Sent folder of my Mailbox
and if I use Getfolder on the Managing Partner mailbox to get a item count it works, but when I try to set it as the Item.SaveSentMessageFolder  the item is never moved to the sent folder of that mailbox and the item remains in the Outbox.
 The good thing is that it does reach the recipient every time.

To your second reply I have tried the olNav2folder Function prior to even posting this questions with the same results.

You have clearly already a lot of work regarding the problem but ...

Have you checked what you are using for the managing partner and the sentonbehalfofname property ... check case etc.

Also is your function olSentTrg_ItemSend nested from within the send event ... which I believe it needs to be in order for the sentonbehalfofname to be modifiable.

Chris

Sorry, I did have a Function called GetFolder.
it was taken from

http://msdn.microsoft.com/en-us/library/bb177014(v=office.12).aspx

Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
    Dim TestFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
        
    On Error GoTo GetFolder_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.Folders.item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
    'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function
        
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function

Select allOpen in new window

Note: If I use that link exact script and replace the path with the \\mailbox - managing Partner\Sent Items"
it does display the folder.

I may be missing your point but I inquired if ...

You have checked what you are using for the managing partner and the sentonbehalfofname property ... check case etc.

Also is your function olSentTrg_ItemSend nested from within the send event ... which I believe it needs to be in order for the save folder to be modifiable.

Chris

Not sure what you are asking regarding the Property?
Can you give me an example?
When the senditem event catches that the there is a Dist List in the TO field the various parts are triggered properly and it does ask if I want to add the Managing Partner address to the SendonBehalfof
This part of the code works perfect, but went I change the path in the Getfolder() it does not save it.  

    If Item.SentOnBehalfOfName = "Managing Partner" Then
        Set fldr = GetFolder("\\Mailbox - Smith\Sent Items\ManagerCopy")
        Set Item.SaveSentMessageFolder = fldr
    End If

Select allOpen in new window

When you say nested I should not be calling the GetFolder Function?

What I am getting at is there is nothing that I can see that is 'wrong' in your code BUT I am concerned that when you set the sentonbehalfofname that the value stored in the email is different to that you are testing therefore for example generate an output to show for example:

MsgBox ">" & Item.SentOnBehalfOfName & "<"
    If Item.SentOnBehalfOfName = "Managing Partner" Then
        Set fldr = GetFolder("\\Mailbox - Smith\Sent Items\ManagerCopy")
        Set Item.SaveSentMessageFolder = fldr
    End If

Select allOpen in new window

Can I comment that it is difficult to try and help when you do not reply ... I have twice asked for you to confirm that the actual value of Item.SentOnBehalfOfName matches to that you are expecting ... including case on the basis that in a test everything seemed to work as expected.

Chris

The actual value is correct:
Managing Partner XXXX XXX it is resolved by GAL without any issues.

Private Sub olSentTrg_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim fldr As Outlook.MAPIFolder




'Step 1
'This is where the Regular Expression is challanged. Function ProcessString
'is trigger upon Sending.  This will look at both the TO field and Subject Line
'to see if there are any 5 numeric characters or more - 3 numeric characters or more
'sequence.  If this is true the next step is to see if the From field is blank

If InStr(1, Item.To, "00000-000", 1) Or InStr(1, Item.To, "XXX Managers", 1) = True Then
        If Len(Item.SentOnBehalfOfName) = 0 Then
                 If MsgBox("You are sending to a Distbuition Group and you did" & vbCrLf & _
                                "not fill in the From field with Managing Partner " & vbCrLf & vbCrLf & _
                                "Do you want to add Managing Partner" & vbCrLf & _
                                "to the From Field?", _
                                vbYesNo + vbExclamation) = vbYes Then
                                Cancel = True
           
           Item.SentOnBehalfOfName = "Managing Partner XX XXXX"
           
           End If
        End If
End If
    If Item.SentOnBehalfOfName = "Managing Partner XX XXXX" Then
        Set fldr = GetFolder("\\Mailbox - XXXXXXXX, Michael K.\Sent Items\ManagerCopy")
        Set Item.SaveSentMessageFolder = fldr
    End If
    

End Sub 

Select allOpen in new window

The Code above works perfectly.  The sent item is placed in the FLDR Folderpath without any issues and I am able to reply back to Managing Partner XX XXXX as if it was sent from that Managing Partner Mailbox.

If I change the path the Managing Partner Sent Folder the item never is placed in the sent folder of the mailbox and the copy remains in the Outbox.

    If Item.SentOnBehalfOfName = "Managing Partner XX XXXX" Then
        Set fldr = GetFolder("\\Mailbox - Managing Partner XX XXXX\Sent Items")
        Set Item.SaveSentMessageFolder = fldr
    End If

Select allOpen in new window

Note sure if this answers your question. Please let me know

The graphic shows the PST as "Mailbox - Managing Partner" but what I was interested to see was what is actually stored in the email for the managing partner i.e. the code I posted earlier replacing:

    If Item.SentOnBehalfOfName = "Managing Partner XX XXXX" Then
        Set fldr = GetFolder("\\Mailbox - Managing Partner XX XXXX\Sent Items")
        Set Item.SaveSentMessageFolder = fldr
    End If

Select allOpen in new window

with

MsgBox ">" & Item.SentOnBehalfOfName & "<"
    If Item.SentOnBehalfOfName = "Managing Partner XX XXXX" Then
        Set fldr = GetFolder("\\Mailbox - Managing Partner XX XXXX\Sent Items")
        Set Item.SaveSentMessageFolder = fldr
    End If

Select allOpen in new window

i.e. what exactly does the msgbox show?

Chris

Debug.Print Item.SentOnBehalfOfName
Results:
Managing Partner XX XXXX

Does that Help.


As stated before this If Then Statement works if I save to a folder within the actual senders mailbox, but does not save if I set it to the Second Mailbox Store that is mounted.

I can try the PickFolder method and see if that works.

I need to try and set up a representative test ... so are you calling your olSentTrg_ItemSend routine from inside the application_itemsend function?

Chris

I have it initialized at startup.

Class Module

Public WithEvents olSentTrg As Outlook.Application


Sub Initialize_handler()
 
 Set olSentTrg = Outlook.Application
 
 
End Sub

Private Sub olSentTrg_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim fldr As Outlook.MAPIFolder




'Step 1
'This is where the Regular Expression is challanged. Function ProcessString
'is trigger upon Sending.  This will look at both the TO field and Subject Line
'to see if there are any 5 numeric characters or more - 3 numeric characters or more
'sequence.  If this is true the next step is to see if the From field is blank

If InStr(1, Item.To, "<Replace with Dist List Name", 1) = True Then
        If Len(Item.SentOnBehalfOfName) = 0 Then
                 If MsgBox("You are sending to a Distbuition Group and you did" & vbCrLf & _
                                "not fill in the From field with Managing Partner " & vbCrLf & vbCrLf & _
                                "Do you want to add Managing Partner" & vbCrLf & _
                                "to the From Field?", _
                                vbYesNo + vbExclamation) = vbYes Then
                                Cancel = True
           
           Item.SentOnBehalfOfName = "<Replace with Senders name>"
           
           End If
        End If
End If
    If Item.SentOnBehalfOfName = "<Replace with Senders name>" Then
        Set fldr = GetFolder("\\Mailbox - <"replace with mailbox name">\Sent Items\ManagerCopy")
        Set Item.SaveSentMessageFolder = fldr
        Debug.Print ">" & Item.SentOnBehalfOfName & "<"
    End If
    

End Sub

Select allOpen in new window

Module Getfolder

Function GetFolder(ByVal FolderPath As String) As Outlook.folder
    Dim TestFolder As Outlook.folder
    Dim FoldersArray As Variant
    Dim i As Integer
        
    On Error GoTo GetFolder_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.folders
            Set SubFolders = TestFolder.folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
    'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function
        
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function

Select allOpen in new window

I just tried using Pickfolder and debug.print the output.
The path is correct and the same results.

Maybe there is some sort of security on the mailbox.
I am able to move it without any issues, but not able to direct the sent item to be saved in the desired location.

For now I will be using the Save locally and have the ItemAdd event move items when they arrive.
Like said earlier it seems like I am taking the long road here.

Can you confirm the calling process for your sub?

Are you talking about the get folder  function

No, the main sub i.e. olSentTrg_ItemSend, how is this triggered?

Chris

It is called upon the startup when Outlook is opened

The Class is initialized during startup of Outlook.
Placed in the ThisOutlookSession

Dim mAddItems As New Class3
Dim mReminder As New Class1
Dim mDistGroup As New Class4
Dim mItemAdd As New Class2


Private Sub Application_startup()
mAddItems.Initialize_handler
mReminder.Initialize_handler
mDistGroup.Initialize_handler
mItemAdd.Initialize_handler
End Sub

Select allOpen in new window

No, I am referring to the routine you initially posted i.e olSentTrg_ItemSend.  HOw / where is this routine triggered?

Chris

its SendItem Event
http://msdn.microsoft.com/en-us/library/office/aa280532(v=office.11).aspx

How it works is when The Send event happens it is caught prior to sending and allows you to run various steps prior to sending.

http://msdn.microsoft.com/en-us/library/office/aa171284(v=office.11).aspx

ie.
Say you want to have a certain message appended to all e-mails.
You can use the ItemSend Event to catch the e-mail parse the body and append to the message body then have it send out or do something else.

I just placed it in its own class and initialized it upon startup.

If you placed the a sub in THISOUTLOOKSESSSION it will do the same thing as the ITEMSend link appove, but just rather than using all the other lines all you need is

Private Sub application_ItemSend(ByVal Item As Object, Cancel As Boolean)
	Dim prompt As String
	prompt = "Are you sure you want to send " & Item.Subject & "?"
	If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
		Cancel = True
	End If
End Sub

Select allOpen in new window

It is the same thing as my class3 being initialized and then anytime there is a Send Event this is called  olSentTrg

Does that help in anyway.

To help lay this out,
ThisOutlookSession
Here is the Class

Ah,

I would expect you to use the itemsend event:

application_itemsend and either place your code therein or better place a call to your own routine therein passing the itemsend properties down.

Temporarily disable the code for the class and you should see it work.

Chris

I wi give that a shot later this week.

I am closing this question and awarding you the full points because your suggested a solution that was partial used  to accomplish the results I was looking for.

I also selected my solution as part of the resolution.

Happy New Year