VBA Moving MailItem after Subject Line Change

Question

I have a query below, I am trying to amend the Subject Line of an incoming email and then move it to a Folder within the Mailbox (Not the Inbox).

I need to do this because an external program watches this folder and files the emails accordingly.

I can find plenty on how to move an Item systematically externally, or moving an object within an Inbox Sub Folder but not a folder under the main 'Mailbox'.

Can anyone shed any light for me please, bear in mind this runs as a 'Run As Script' when the mail comes in.

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 objNS As Outlook.NameSpace
'Set objNS = Application.GetNamespace("MAPI")

'Set myInbox = objNS.GetDefaultFolder(olFolderInbox)

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=xxx;Initial Catalog=xxxx;User ID=xxxxx;Password=xxx;"
'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.[p_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.Display
myItem.Subject = strSubject
myItem.Save

rs.Close

'myItem.Move fldrOAtt

Set rs = Nothing
Set cnn = Nothing

End Sub

Answer 1

If the folder is on the same level as the Inbox, retrieve its parent, then go down one level:

set subfolder = myInbox.Parent.Folders.Item("the folder name")