Need VBA Outlook help- saves over duplicate file

Trying to auto save incoming attachments based on a rule and then running VBA to save the file to a folder. The code works but I ran into a problem when there are duplicate files named with the same name, it will just overwrite the old file. Is there a way to add to the following code a number to end of the naming convention? like 1 , 2, 3 and so on so that it will not overwrite the other file? or better yet add the date to the end of the file path when saving? Thanks for your help

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Const saveFolder As String = "C:\Users\wrighta\Documents\Test"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

Use the following, versions of which I have posted here previously

Code:

---

Option Explicit

Public Sub saveAttachtoDisk(olItem As Outlook.MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 26 Jun 2019
Dim olAttach As Attachment
Dim strFName As String
Dim strExt As String
Dim j As Long
Dim strSaveFldr As String


    strSaveFldr = Environ("USERPROFILE") & "\Documents\Test\"
    CreateFolders strSaveFldr


    On Error GoTo lbl_Exit
    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 = olAttach.fileName
                strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
                strFName = FileNameUnique(strSaveFldr, strFName, strExt)
                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 FileNameUnique(strPath As String, _
                                strFileName As String, _
                                strExtension As String) As String
'An Outlook macro by Graham Mayor
Dim lngF As Long
Dim lngName As Long
    lngF = 1
    lngName = Len(strFileName) - (Len(strExtension) + 1)
    strFileName = Left(strFileName, lngName)
    Do While FileExists(strPath & strFileName & Chr(46) & strExtension) = True
        strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
    Exit Function
End Function


Private Function FileExists(filespec) As Boolean
'An Outlook macro by Graham Mayor
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(filespec) Then
        FileExists = True
    Else
        FileExists = False
    End If
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

---