Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Private Sub Application_Startup()
Set SentItems = Outlook.Session.GetDefaultFolder(olFolderSentMail).Items
Set SentItems2 = GetFolderPath("name@account2.com\Sent Items").Items
End Sub
Private Sub Application_Quit()
Set SentItems = Nothing
Set SentItems2 = Nothing
End Sub
Private Sub SentItems_ItemAdd(ByVal Item As Object)
Item.UnRead = False
Item.Move Outlook.Session.GetDefaultFolder(olFolderInbox)
End Sub
Private Sub SentItems2_ItemAdd(ByVal Item As Object)
Item.UnRead = False
Item.Move GetFolderPath("name@account2.com\Inbox")
End Sub