VBA - Change Outlook Subject Line on Receipt Of Email - vba

Question

I have written a script that's intended behaviour is supposed to change the Subject Line of a received email.
This is because a Third Party Program monitors an Outlook Folder and posts it to a Virtual Cabinet based on the Subject line being a certain fashion.
I have written the code below that all changes out OK however the Subject Line does not get changed - can anyone shed any light on this at all?
Sub AmendSubject(myItem As Outlook.MailItem)
Dim strBranch As String
Dim strPolRef As String
Dim strTo As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rsSQL As String
Dim strSubject As String
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
'Places the Customer Email Address in a string
strTo = myItem.To
strTo = Replace(strTo, "'", "")
cnn.Open "Provider=SQLOLEDB;Data Source=my-srv;Initial Catalog=DB;User ID=xxxx;Password=xyz;"
'SQL Statement
rsSQL = "SELECT TOP 1 [c].[B#] AS [Branch], p.[PolRef#] AS [Ref] FROM [dbo].[ic_yyclient] AS c" & _
" INNER JOIN [dbo].[ic_brpolicy] AS p ON [c].[B#] = [p].[B#] AND [c].[Ref#] = [p].[Ref#]" & _
" LEFT OUTER JOIN [dbo].[ic_BD_ATS1] AS ats1 ON [p].[B#] = [ats1].[B#] AND [p].[PolRef#] = [ats1].[PolRef#]" & _
" WHERE [Ptype] IN ('PC','TW') AND (c.[Email] = '" & strTo & "' OR ats1.[Email] = '" & strTo & "' OR ats1.[Parents_email] = '" & strTo & "') AND [Term_code] IS NULL" & _
" ORDER BY [ats1].[PolRef#] desc"
Debug.Print rsSQL
rs.Open rsSQL, cnn, adOpenForwardOnly
With rs
While Not .EOF
strBranch = !Branch
strPolRef = !Ref
.MoveNext
Wend
End With
strSubject = "REF: 0" & strBranch & "-" & strPolRef & "-C<Email To Client>NB Documentation Email"
myItem.Subject = strSubject
myItem.Save
rs.Close
Set rs = Nothing
Set cnn = Nothing
End Sub