outlook 2010 - warning popup before sending email from personal mail - vba

Question

I've outlook 2010 at my work and linked my personal mail id as a primary account and the rest of the group shared mail id are linked at server level.
So when I send a new email from the group, it selects the personal mail id by default and user have to change it everytime.
I use the below macro to provide a warning pop up when the From is selected as my personal id however this macro warn even if the shared mail id is selected in From.
How to prevent this from warning if the From is not the primary id or personal id or is there a macro to automatically select the From when a new email is created based on the group shared mail id's?
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If InStr(LCase(Item.SendUsingAccount), "sara#example.com.") Then
Prompt$ = "You sending this from sara#example.com. Are you sure you want to send it?"
If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End Sub

Answer 1

From corresponds to the SentOnBehalfOfName property. This is empty until mail is sent, unless you set it in code before sending. Not useful here as you want to verify if you forgot to set it.
Private Sub SetFrom()
Dim curritem As mailItem
Dim uPrompt As String
Set curritem = CreateItem(olMailItem)
curritem.Display
uPrompt = "This mail has not been sent." & vbCr & vbCr
uPrompt = uPrompt & "The SentOnBehalfOfName (From) property is empty unless set in the code." & vbCr & vbCr
uPrompt = uPrompt & "See between the quotes." & vbCr & vbCr
MsgBox uPrompt & Chr(34) & ActiveInspector.currentItem.SentOnBehalfOfName & Chr(34)
' Note: The From in the user interface does not populate the property."
curritem.SentOnBehalfOfName = "sharedmailbox#example.com"
' For demonstration purposes. Not necessary to display in real code.
curritem.Close olSave
curritem.Display
MsgBox "SentOnBehalfOfName set in the code." & vbCr & vbCr & _
"The SentOnBehalfOfName (From) is set to: " & curritem.SentOnBehalfOfName
ExitRoutine:
Set curritem = Nothing
End Sub
Your attempt to verify SendUsingAccount has likely failed due to having one account with many mailboxes where you want many accounts.
Sub Account_name()
Dim olAcct As account
Dim countAcc As Long
Dim i As Long
countAcc = Session.Accounts.count
For i = 1 To countAcc
Debug.Print "Account.....: " & i
Debug.Print " DisplayName: " & Session.Accounts.Item(i).DisplayName
Debug.Print " UserName : " & Session.Accounts.Item(i).userName
Debug.Print
Next
End Sub
If you find you have only one account see Add an email account to Outlook to to add accounts if you have the required permissions.