Using a message with your example subject, does the following get the path you want?
Sub Macro1()
Dim olItem As MailItem
Dim strPath As String
Dim strProject As String, strDate As String
Dim strSubject As String, strSender As String
On Error Resume Next
Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olItem = ActiveInspector.currentItem
Case olExplorer
Set olItem = Application.ActiveExplorer.Selection.Item(1)
End Select
With olItem
strSubject = .Subject
strDate = Format(.SentOn, "yyyymmdd")
strSender = .sender
End With
strPath = GetPath(strSubject)
If Not strPath = "" Then
strProject = Mid(strSubject, Len(strPath) + 1)
strProject = CleanFileName(strProject)
strPath = "H:\400-499\" & strPath & "\" & strProject & "Correspondence by " & strDate & "_" & strSender
End If
MsgBox strPath
lbl_Exit:
Set olItem = Nothing
Exit Sub
End Sub
Private Function GetPath(strSubject As String) As String
Dim vNum As Variant
vNum = Split(strSubject, Chr(32))
strSubject = Replace(vNum(0), "-", "")
If IsNumeric(strSubject) = True Then
strSubject = CStr(vNum(0))
GetPath = strSubject
End If
End Function
Private Function CleanFileName(strFileName As String) As String
Dim arrInvalid() As String
Dim lng_Index As Long
'Define illegal characters (by ASCII CharNum)
arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
'Remove any illegal filename characters
CleanFileName = strFileName
For lng_Index = 0 To UBound(arrInvalid)
CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lng_Index)), Chr(95))
Next lng_Index
lbl_Exit:
Exit Function
End Function