Moving Sent Items To Another Mailbox Sent Folder.

[Shazam]

Hi,

I have a additional mailbox on my Outlook 2010 64-bit. I send mails on the behalf of another mail box. But when I send out a mail from the other mail box...it goes to my personal sent item folder. I would like the mail go to the SendAs behalf sent item folder.

So I found this code below but gives me an error when the code is activated.

"Run-time error '449':
Argument not optional"

I click on debug and it highlight this line.

Item.Move = olkFolder

Anyone can help me? or anyone has another version of this code?

Private WithEvents olkSentItems As Outlook.Items

Private Sub Application_Quit()
Set olkSentItems = Nothing
End Sub

Private Sub Application_Startup()
Set olkSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub olkSentItems_ItemAdd(ByVal Item As Object)
Dim olkFolder As Outlook.MAPIFolder
If Item.Class = olMail Then
'Change the name on the following line as needed. It will have to match the name in the message exactly.
If Item.SenderName = "Support" Then
'Change the folder path on the following line to that of the folder you want the item moved to
Set olkFolder = OpenOutlookFolder("Mailbox - Support\Sent Items")
Item.Move = olkFolder
End If
End If
Set olkFolder = Nothing
End Sub

Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant, _
varFolder As Variant, _
olkFolder As Outlook.MAPIFolder
On Error GoTo ehOpenOutlookFolder
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
If Left(strFolderPath, 1) = "\" Then
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
End If
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
If IsNothing(olkFolder) Then
Set olkFolder = Session.Folders(varFolder)
Else
Set olkFolder = olkFolder.Folders(varFolder)
End If
Next
Set OpenOutlookFolder = olkFolder
End If
On Error GoTo 0
Exit Function
ehOpenOutlookFolder:
Set OpenOutlookFolder = Nothing
On Error GoTo 0
End Function

[AdonPr]

I use this code in outlook 2003. Think i got it from JP www_jpsoftwaretech_com



Option Explicit
Public WithEvents sentItems As Outlook.Items
Private Sub Application_Startup()
Dim ns As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Set ns = Application.GetNamespace("MAPI")
Set fld = ns.GetDefaultFolder(olFolderSentMail)
Set sentItems = fld.Items
Set fld = Nothing
Set ns = Nothing
End Sub
Private Sub Application_Quit()
Set sentItems = Nothing
End Sub
Private Sub SentItems_ItemAdd(ByVal Item As Object)

If TypeOf Item Is Outlook.MailItem Then
If Item.SentOnBehalfOfName = "~ Name1" Then
Item.Move Application.GetNamespace("MAPI").Folders("Mailbox - ~ Name1").Folders("Sent Items")
ElseIf Item.SentOnBehalfOfName = "~ Name2" Then
Item.Move Application.GetNamespace("MAPI").Folders("Mailbox - ~ Name2").Folders("Sent Items")
ElseIf Item.SentOnBehalfOfName = "~ Name3" Then
Item.Move Application.GetNamespace("MAPI").Folders("Mailbox - ~ Name3").Folders("Sent Items")
ElseIf Item.SentOnBehalfOfName = "~ Name4" Then
Item.Move Application.GetNamespace("MAPI").Folders("Mailbox - ~ Name4").Folders("Sent Items")
ElseIf Item.SentOnBehalfOfName = "~ Name5" Then
Item.Move Application.GetNamespace("MAPI").Folders("Mailbox - ~ Name5").Folders("Sent Items")
End If
End If
End Sub