Outlook VBA - Using PickFolder to copy to PST - vba

Question

A user has some VBA code that pops up with a folder view to choose where to save a copy of "Sent Items" to when "Send" is pressed.
The issue is, it only works with the main mailbox, and not PST's
Is there a way to allow this code to copy to PST folders too?
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
Set msg = MailItem.Copy
msg.UnRead = False
msg.Save
msg.Move objNS.GetDefaultFolder(olFolderSentMail)
Else
Set objFolder = _
objNS.GetDefaultFolder(olFolderSentMail)
Set Item.SaveSentMessageFolder = objFolder
Set msg = MailItem.Copy
msg.UnRead = False
msg.Save
msg.Move objNS.GetDefaultFolder(olFolderSentMail)
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

Answer 1

Do you mean you want the messages moved to somewhere other than the default Sent Items folder? If so, you either need to ask the user to pick it or get a Folder object via NameSpace.GetFolderFromID if you have saved the Folder.EntryID value for the destination folder somewhere. Otherwise, you'll have to find the folder by name by looping through Store.Folders for every Store in NameSpace.Stores, which could get nasty.