Macro that does not overwrite but add a number

[snhnic]

Below macro works fine, but when there are more selected messegas with the same attachment it overwrite. I would like that the macro writes a number to it. attachent.pdf and then attachement(1).pdf and so on or somtehing like it. Can this be done in the macro below? I dit not created it and I'm not a programmer.


Sub MoveAttachmentsToFolder()
Dim olMailItem As MailItem
Dim olAtt As Attachment
Dim intAtt As Integer
Dim strPath As String, FileName As String

If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("select E-mail Items")
Exit Sub
End If


'strPath = fnShellBrowseForFolderVB
strPath = "c:\attachment"

If Len(strPath) = 0 Then
Exit Sub
End If
strPath = strPath & "\"

intAtt = 0
For Each olMailItem In Application.ActiveExplorer.Selection
If olMailItem.Class = olMail Then
For Each olAtt In olMailItem.Attachments
FileName = strPath & olAtt.FileName
olAtt.SaveAsFile FileName

intAtt = intAtt + 1
Next
End If
Next
MsgBox intAtt & " Attachement(s) Saved in: " & strPath
End Sub

 

[oliv-]

Hi,

 N = 1
                MemPath = pj.FileName
                PathNomExport = MemPath
                While Dir(Repertoire & PathNomExport) <> ""
                    PathNomExport = "(" & N & ")" & MemPath
                    N = N + 1
                Wend
                pj.SaveAsFile Repertoire & PathNomExport

there a full example
VBA OUTLOOK: extraire des pièces jointes et les sauvegarder