The macro will not appear in the macro list because it is not a stand alone macro. It requires a parameter - here olItem which refers to the message being processed.
Private Sub SaveAttachments(olItem As MailItem)
It also needs Private changing to Public (or removing altogether) as this was used when the macro was run from the ProcessAttachment macro i.e.
Sub SaveAttachments(olItem As MailItem)
As it is intended to be run from a Rule the Private part will make it invisible to the Scripts selector.
Rule.jpg
Had you copied all the code and jkust modified the main code your macros list should have displayed the ProcessAttachment macro, which can be run to test the code. The full code is as follows:
Option Explicit
Sub ProcessAttachment()
'An Outlook macro by Graham Mayor
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
SaveAttachments olMsg
lbl_Exit:
Exit Sub
End Sub
Sub SaveAttachments(olItem As MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 10 Aug 2018
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim j As Long
Dim strSaveFldr As String
On Error GoTo lbl_Exit
strSaveFldr = Environ("USERPROFILE") & "\Documents\Attachments\"
CreateFolders strSaveFldr
If olItem.Attachments.Count > 0 Then
For j = 1 To olItem.Attachments.Count
Set olAttach = olItem.Attachments(j)
If olAttach.fileName Like "mavrpt*.*" Then
strFname = CleanFileName(olItem.Subject) & ".xls"
strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
olAttach.SaveAsFile strSaveFldr & strFname
End If
Next j
olItem.Save
End If
lbl_Exit:
Set olAttach = Nothing
Set olItem = Nothing
Exit Sub
End Sub
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
Private Function FolderExists(fldr) As Boolean
'An Outlook macro by Graham Mayor
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If (FSO.FolderExists(fldr)) Then
FolderExists = True
Else
FolderExists = False
End If
lbl_Exit:
Exit Function
End Function
Private Function CreateFolders(strPath As String)
'An Outlook macro by Graham Mayor
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
vPath = Split(strPath, "\")
strPath = vPath(0) & "\"
For lngPath = 1 To UBound(vPath)
strPath = strPath & vPath(lngPath) & "\"
If Not FolderExists(strPath) Then MkDir strPath
Next lngPath
lbl_Exit:
Exit Function
End Function
Don't forget to save the project when you quit Outlook!