Desanexar no outlook, agrupando anexos com mesmo nome

Para evitar que os anexos com o mesmo nome sejam sobrepostos ao serem salvos, você pode modificar a sua macro para renomear os arquivos de forma que eles se tornem exclusivos. Uma abordagem comum é adicionar um contador ou a data e hora ao nome do arquivo para diferenciá-los.

Aqui está uma versão modificada da sua macro que implementa essa lógica:

```vba Public Sub Desanexar_A() On Error GoTo erro 'Macro para desanexar arquivo

Dim ObjApp As Outlook.Application
Dim Pasta_outlook As Outlook.MAPIFolder
Dim ObjItem As Object
Dim Arq_anexo As Outlook.Attachment
Dim Pasta As String
Dim NomeArquivo As String
Dim Extensao As String
Dim NovoNomeArquivo As String
Dim Contador As Integer

'Pasta onde serão gravados os arquivos anexos dos emails:
Pasta = "C:\Arquivos"

Set ObjApp = Outlook.Application
Set Pasta_outlook = ObjApp.ActiveExplorer.CurrentFolder

If MsgBox("Deseja desanexar todos os arquivos da pasta " & Pasta_outlook.Name, vbYesNo) = vbNo Then Exit Sub

For Each ObjItem In Pasta_outlook.Items
    DoEvents
    'Se o objeto é do tipo email, começa a desanexar os arquivos
    If ObjItem.Class = olMail Then
        For Each Arq_anexo In ObjItem.Attachments
            DoEvents

            ' Pega o nome do arquivo e a extensão
            NomeArquivo = Left(Arq_anexo.FileName, InStrRev(Arq_anexo.FileName, ".") - 1)
            Extensao = Mid(Arq_anexo.FileName, InStrRev(Arq_anexo.FileName, "."))

            ' Garante que o novo nome do arquivo seja único
            NovoNomeArquivo = Pasta & "\" & Arq_anexo.FileName
            Contador = 1

            While Dir(NovoNomeArquivo) <> ""
                NovoNomeArquivo = Pasta & "\" & NomeArquivo & "_" & Contador & Extensao
                Contador = Contador + 1
            Wend

            ' Salva o anexo com o novo nome
            Arq_anexo.SaveAsFile NovoNomeArquivo
        Next Arq_anexo
    End If
Next ObjItem

MsgBox "Processo finalizado!", vbOKOnly

Exit Sub

erro: MsgBox Err.Number & " - " & Err.Description, vbOKOnly Exit Sub End Sub ```

Alterações Feitas: 1. Separação do Nome e Extensão: O código agora separa o nome do arquivo e a extensão. Isso permite a adição de um sufixo numérico sem afetar a extensão do arquivo. 2. Contador para Nomes Únicos: Um contador é utilizado para criar um novo nome para o arquivo caso ele já exista na pasta. 3. Verificação de Existência do Arquivo: Antes de salvar o anexo, a macro verifica se um arquivo com o mesmo nome já existe e, se necessário, adiciona um sufixo numérico (ex.: arquivo_1.pdf, arquivo_2.pdf, etc.) até encontrar um nome que não esteja em uso.

Agora, ao desanexar arquivos, eles não serão mais sobrepostos, e cada arquivo com o mesmo nome será salvo com um identificador único.