Need Error Message: Move To code - vba

Question

I have a Move to Code. The issue I am having is a result of multiple accounts. I have 3 to be exact.
Let's say - My boss emailed me, so I jump from my work account to my personal account. I read her email, jump back to my work account and run macro. It moves her (last read/selected) to location. I don't know how many personal emails I've moved by mistake because I forgot to reselect the correct email I meant to move.
How can I produce a prompt message stating I'm in the wrong account and if I should proceed? Note: there may be times I may need to proceed.
Additional Information:
Account One: Chieri Thompson (Personal)
Account Two: Artwork Emails
Account Three: DesignProofsTAC (work email - the one utilizing move to macro)
Under Design Proofs TAC is :
Inbox (folder)
Completed (subfolder)
Outsourced (subfolder)
.....
Private Sub CommandButton7_Click() 'COMPLETED
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim MoveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set objItem = objApp.ActiveInspector.CurrentItem
Set ns = Application.GetNamespace("MAPI")
Set MoveToFolder = ns.Folders("designproofstac").Folders("Inbox").Folders("3_COMPLETED")
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("Not in Correct Folder")
Exit Sub
End If
' this is the error code I want to produce the "you are in wrong account - proceed anyway?" DesignProofsTAC should be "default" i guess.
If MoveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
For Each objItem In Application.ActiveExplorer.Selection
If MoveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move MoveToFolder
End If
End If
Next
Set objItem = Nothing
Set MoveToFolder = Nothing
Set ns = Nothing
End Sub

Answer 1

You may find this simpler than checking accounts.
Untested Code:
Option Explicit
Sub MoveOpenMail 'COMPLETED
' Place a button on the Quick Access Toolbar for an item opened for reading.
Dim ns As NameSpace
Dim MoveToFolder As Folder
Dim objItem As object ' <--- May not be a mailitem
Set ns = Application.GetNamespace("MAPI")
' Do not use On Error Resume Next
' unless there is a specific purpose
' and it is quickly followed by On Error GoTo 0
On Error Resume Next
Set MoveToFolder = ns.Folders("designproofstac").Folders("Inbox").Folders("3_COMPLETED")
On Error GoTo 0
If MoveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "MoveOpenMail VBA Error"
GoTo ExitRoutine
End If
On Error Resume Next
Set objItem = ActiveInspector.CurrentItem
On Error GoTo 0
If objItem Is Nothing Then
MsgBox "Use this code when there is an open mailitem!", vbOKOnly + vbExclamation, "MoveOpenMail VBA Error"
GoTo ExitRoutine
End If
If MoveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move MoveToFolder
End If
Else
MsgBox "Target folder is wrong type!", vbOKOnly + vbExclamation, "MoveOpenMail VBA Error"
End If
ExitRoutine:
Set ns = Nothing
Set MoveToFolder = Nothing
Set objItem = Nothing
End Sub
Sub MoveSelectedMail 'COMPLETED
' Place a button on the Quick Access Toolbar for an open folder
Dim ns As NameSpace
Dim MoveToFolder As Folder
Dim objItem as Object
Dim objExplorer As Explorer
Dim objSelection As Object
Dim x as Long
Set ns = Application.GetNamespace("MAPI")
On Error Resume Next
Set MoveToFolder = ns.Folders("designproofstac").Folders("Inbox").Folders("3_COMPLETED")
On Error GoTo 0
If MoveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "MoveSelectedMail VBA Error"
GoTo ExitRoutine
End If
Set objExplorer = ActiveExplorer
Set objSelection = objExplorer.Selection
If objSelection.Count = 0 Then
MsgBox "Select one or more mailitems"
GoTo ExitRoutine
Else
If MoveToFolder.DefaultItemType = olMailItem Then
' Do not use For Each
' Count backwards when moving or deleting
For x = objSelection.Count to 1 step -1
Set objItem = objSelection.Item(x)
If objItem.Class = olMail Then
objItem.Move MoveToFolder
End If
Next x
Else
MsgBox "Target folder is wrong type!", vbOKOnly + vbExclamation, "MoveSelectedMail VBA Error"
End If
End If
ExitRoutine:
Set ns = Nothing
Set MoveToFolder = Nothing
Set objItem = Nothing
Set objExplorer = Nothing
Set objSelection = Nothing
End Sub

Answer 2

The Namespace class provides the Accounts property which eturns an Accounts collection object that represents all the Account objects in the current profile. The Account class provides the DeliveryStore property which returns a Store object that represents the default delivery store for the account. So, you can compare the Store where you chose the item and the default store for the account you need to move the item.
Also you may find the GetDefaultFolder method of the Store class helpful, it returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.