Rename attachments before saving

You can use the following code to perform this string manipulation:

arquivo = objAttachments.Item(i).FileName
nome_arquivo = fso.GetBaseName(arquivo)
extensao_arquivo = Replace(arquivo, nome_arquivo, "")

If arquivo Like ("*MIPS_*") Then
    If j = 3 Then
        k = k + 1
        j = 0
    End If
    strFile = nome_arquivo & "_" & arr(k) & extensao_arquivo
    j = j + 1

Else
    'strFile = arquivo
End If

If the attachment contains the word MIPS_ it creates the files in order, otherwise save only the name of the attached file.

Explanation

• arquivo = objAttachments.Item(i).FileName is the name of the attachment, for example: "File_Name.txt"
• nome_arquivo = fso.GetBaseName(arquivo) is the name of the file without the extension, eg "FileName"
• extensao_arquivo = Replace(arquivo, nome_arquivo, "") is the file extension, eg ".txt"
• strFile = nome_arquivo & "_" & arr(k) & extensao_arquivo concatenates the final file name that will be saved, with some value of the arr vector. The index k of the vector is incremented every time 4 MIPS_ are saved.

Code

Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem               'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String
    Dim f As Long
    Dim NewName
    Dim arr As Variant
    Dim j As Long, k As Long
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")


    ' Get the path to your My Documents folder
    'strFolderpath = "C:\Users\brunoco\Desktop\Teste Macro MIPS\"
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

    ' Set the Attachment folder.
    strFolderpath = "C:\Users\brunoco\Desktop\Teste Macro MIPS\"

    ' Check each selected item for attachments. If attachments exist,
    ' save them to the strFolderPath folder and strip them from the item.
    For Each objMsg In objSelection

        ' This code only strips attachments from mail items.
        ' If objMsg.class=olMail Then
        ' Get the Attachments collection of the item.
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
        strDeletedFiles = ""

        If lngCount > 0 Then

            ' We need to use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.

            For i = lngCount To 1 Step -1
                k = 0
                arr = Array("SEX", "SAB", "DOM")
                For Each objAttachments In objMsg
                    f = f + 1

                    arquivo = objAttachments.Item(i).FileName
                    nome_arquivo = fso.GetBaseName(arquivo)
                    extensao_arquivo = Replace(arquivo, nome_arquivo, "")

                    If arquivo Like ("*MIPS_*") Then
                        If j = 3 Then
                            k = k + 1
                            j = 0
                        End If
                        strFile = nome_arquivo & "_" & arr(k) & extensao_arquivo
                        j = j + 1

                    Else
                        strFile = arquivo
                    End If


                    'If strSubject.Contains("VIDE") Then
                    ' Combine with the path to the Temp folder.
                    strFile = strFolderpath & strFile


                    ' Save the attachment as a file.
                    objAttachments.Item(i).SaveAsFile strFile

                    ' Delete the attachment.
                    'objAttachments.Item(i).Delete

                    'write the save as path to a string to add to the message
                    'check for html and use html tags in link
                    If objMsg.BodyFormat <> olFormatHTML Then
                        strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
                    Else
                        strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
                                          strFile & "'>" & strFile & "</a>"
                    End If

                    'Use the MsgBox command to troubleshoot. Remove it from the final code.
                    'MsgBox strDeletedFiles
                Next


            Next i

            ' Adds the filename string to the message body and save it
            ' Check for HTML body
            If objMsg.BodyFormat <> olFormatHTML Then
                objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
            Else
                objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
            End If
            objMsg.Save
        End If
    Next

ExitSub:

    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub