i Tried this but with error:
Option Explicit

Sub SaveMSGandATTACHEMENTS()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    
    ' ============================== save function start =========================
    Dim xShell As Object
    Dim xFolder As Object
    Dim strStartingFolder As String
    Dim xFolderItem As Object
    Dim xFileName As String
    Dim objOL As Outlook.Application
    
    Set xShell = CreateObject("Shell.Application")


    On Error Resume Next
    ' Bypass error when xFolder is nothing on Cancel
    Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, strStartingFolder)
    ' Remove error bypass as soon as the purpose is served
    On Error GoTo 0
    
    If Not TypeName(xFolder) = "Nothing" Then
        Set xFolderItem = xFolder.self
        xFileName = xFolderItem.Path
        ' missing path separator
        If Right(xFileName, 1) <> "\" Then xFileName = xFileName & "\"
    Else
        xFileName = ""
        Exit Sub
    End If
     ' ============================== save function end =========================
    
    SaveAttachments olMsg
    SaveMessageAsMsg olMsg
lbl_Exit:
    Exit Sub
End Sub




Public Sub SaveAttachments(olItem As MailItem)
'Graham Mayor - 
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim j As Long, lng_Index As Long
Dim arrInvalid() As String
Dim xFileName As String


    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    On Error Resume Next
    If olItem.Attachments.Count > 0 Then
        For j = 1 To olItem.Attachments.Count
            Set olAttach = olItem.Attachments(j)
            'If Not olAttach.fileName Like "image*.*" Then
            strFname = olItem.Subject & "_" & olAttach.FileName
            For lng_Index = 0 To UBound(arrInvalid)
                strFname = Replace(strFname, Chr(arrInvalid(lng_Index)), Chr(95))
            Next lng_Index
            strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
            strFname = FileNameUnique(xFileName, strFname, strExt)
            olAttach.SaveAsFile xFileName & strFname
            'End If
        Next j
        olItem.Save
    End If
lbl_Exit:
    Set olAttach = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub
Public Sub SaveMessageAsMsg(olItem As MailItem)
'Update by Extendoffice 2018/3/5
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim xName, xFileName As String
Dim xSender As String
Dim xFileName As String


            
On Error Resume Next
For Each xObjItem In Outlook.ActiveExplorer.Selection
    If xObjItem.Class = olMail Then
        Set xMail = xObjItem
        xName = Left(CleanFileName(xMail.Subject), 40)
        xSender = CleanFileName(xMail.senderName)
        xDtDate = xMail.ReceivedTime
        xName = Format(xDtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
              vbUseSystem) & Format(xDtDate, "-hhnn", _
              vbUseSystemDayOfWeek, vbUseSystem) & "-" & xSender & "-" & xName & ".msg"
        xPath = xFileName + xName
        xMail.SaveAs xPath, olMsg
    End If
Next
End Sub


Private Function FileNameUnique(strPath As String, _
                                strFileName As String, _
                                strExtension As String) As String
'Graham Mayor - https://www.gmayor.com - Last updated - 22 Jul 2019
Dim lngF As Long
Dim lngName As Long
Dim fso As Object
    lngF = 1
    Set fso = CreateObject("Scripting.FileSystemObject")
    lngName = Len(strFileName) - (Len(strExtension) + 1)
    strFileName = Left(strFileName, lngName)
    Do While fso.FileExists(strPath & strFileName & Chr(46) & strExtension) = True
        strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
    Set fso = Nothing
    Exit Function
End Function


Public Function CleanFileName(strFileName As String) As String


    
    Dim Invalids
    Dim e
    Dim strTemp As String
    
    Invalids = Array("?", "*", ":", "|", "<", ">", "[", "]", """", "/")
    
    strTemp = strFileName
    
    For Each e In Invalids
        strTemp = Replace(strTemp, e, " ")
        'strTemp = Replace(strTemp, e, "")
    Next
    
    CleanFileName = strTemp
    
End Function
Private Function CreateFolders(strPath As String) As Boolean
'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) & "\"
        On Error GoTo Err_Handler
        If Not FolderExists(strPath) Then MkDir strPath
    Next lngPath
    CreateFolders = True
lbl_Exit:
    Exit Function
Err_Handler:
    MsgBox "The path " & strPath & " is invalid!"
    CreateFolders = False
    Resume lbl_Exit
End Function