Try these macros:
Sub SaveEmailsWithCodeToDisk()
On Error Resume Next
Dim objNS As Outlook.NameSpace
Dim objItems As Outlook.Items
Dim objEmail As Outlook.MailItem
Dim objInbox As Outlook.MAPIFolder
Dim strFileName As String
Dim intX As Integer
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objInbox.Items
For intX = 1 To objItems.Count
If objItems.Item(intX).Class = olMail Then
Set objEmail = objItems.Item(intX)
If InStr(objEmail.Subject, "TEXT OCCURRENCE TO SEARCH FOR") > 0
Then
strFileName = GetValidFileName(objEmail.Subject)
objEmail.SaveAs "C:\Temp\" & strFileName & ".msg", olMSG
End If
End If
Next
Set objNS = Nothing
Set objItems = Nothing
Set objEmail = Nothing
Set objInbox = Nothing
End Sub
Function GetValidFileName(InputString) As String
GetValidFileName = Replace(InputString, ":", "_")
GetValidFileName = Replace(GetValidFileName, "/", "_")
GetValidFileName = Replace(GetValidFileName, "\", "_")
GetValidFileName = Replace(GetValidFileName, "!", "_")
GetValidFileName = Replace(GetValidFileName, "*", "_")
GetValidFileName = Replace(GetValidFileName, "?", "_")
GetValidFileName = Replace(GetValidFileName, ";", "_")
GetValidFileName = Replace(GetValidFileName, "<", "_")
GetValidFileName = Replace(GetValidFileName, ">", "_")
GetValidFileName = Replace(GetValidFileName, "|", "_")
GetValidFileName = Replace(GetValidFileName, """", "_")
End Function