Assuming that all the required filenames are in a similar format of 3 digits hyphen 7 digits, then it is fairly simple. Create a rule to identify messages from the specific sender and associate the following script with that rule. The attachment will be saved to the folder named from the first three digits, which will be created if not present. I have included a test macro so that you can test it on an existing message.
Option Explicit
Sub SaveAttachment(Item As Outlook.MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Jul 2019
Dim olAtt As Attachment
Dim strFileName As String
Dim strName As String
Dim strFolder As String
strFolder = Environ("USERPROFILE") & "\Documents\"
If Item.Attachments.Count > 0 Then
For Each olAtt In Item.Attachments
strName = Left(olAtt.fileName, InStrRev(olAtt.fileName, ".") - 1)
If strName Like "???-???????" Then
strFolder = strFolder & Split(strName, "-")(0) & Chr(92)
CreateFolders strFolder
olAtt.SaveAsFile strFolder & olAtt.fileName
Exit For
End If
Next olAtt
End If
lbl_Exit:
Set olAtt = Nothing
Exit Sub
End Sub
Private Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lng_PathSep As Long
Dim lng_PS As Long
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
lng_PathSep = InStr(3, strPath, "\")
If lng_PathSep = 0 Then GoTo lbl_Exit
Set oFSO = CreateObject("Scripting.FileSystemObject")
Do
lng_PS = lng_PathSep
lng_PathSep = InStr(lng_PS + 1, strPath, "\")
If lng_PathSep = 0 Then Exit Do
If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
Loop
Do Until lng_PathSep = 0
If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
oFSO.CreateFolder Left(strPath, lng_PathSep)
End If
lng_PS = lng_PathSep
lng_PathSep = InStr(lng_PS + 1, strPath, "\")
Loop
lbl_Exit:
Set oFSO = Nothing
Exit Sub
End Sub
Sub TestMacro()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
SaveAttachment olMsg
lbl_Exit:
Set olMsg = Nothing
Exit Sub
End Sub