VBScript Move Sent Items to Inbox in Outlook

VBScript-Move-Sent-Items-to-Inbox-in-Outlook.vbs

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