Help, How to save picture to specific folder with customized name (1 Viewer)

Option Compare Database

Public Enum acFileType
    acPicture = 1
    acFiles = 2
End Enum

Public Function UploadFile(strDestinationPath As String, _
                            FileType As acFileType, _
                            Optional bIsUpload As Boolean = True) As String
On Error GoTo ErrorHandler
    Dim strSourceFile As String
    Dim strDestinationFile As String
    Dim strFullFileName As String
    Dim FSO As Object
    

    If Right$(strDestinationPath, 1) <> "\" Then
        strDestinationPath = strDestinationPath & "\"
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(strDestinationPath) Then
        MsgBox "Folder [" & strDestinationPath & "] can not be found", vbCritical, "Message!"
        Set FSO = Nothing
        Exit Function
    End If
    
    With Application.FileDialog(3)
        .title = "Choose File"
        .InitialFileName = ""
        .Filters.Clear
        Select Case FileType
        Case 1
            .Filters.Add "Graphics Files", "*.jpg;*.bmp;*.gif;*.png"
        Case 2
            .Filters.Add "Files", "*.pdf;*.doc;*.docx;*.xls;*.rar"
        Case Else
            .Filters.Add "All Files", "*.*"
        End Select
        .AllowMultiSelect = False
        If .Show Then
            strSourceFile = .SelectedItems.Item(1)
            strDestinationFile = strDestinationPath & Mid$(strSourceFile, InStrRev(strSourceFile, "\") + 1)
            strFullFileName = Mid$(strSourceFile, InStrRev(strSourceFile, "\") + 1)
            
            If bIsUpload = True Then
                If FSO.FileExists(strDestinationFile) = True Then
                    If MsgBox("File already exit, do you want to cover", vbOKCancel + vbInformation, "Confirm!") = vbOK Then
                        FSO.CopyFile strSourceFile, strDestinationFile, True
                    Else
                        Exit Function
                    End If
                Else
                    FSO.CopyFile strSourceFile, strDestinationFile
                End If
                Set FSO = Nothing
                UploadFile = strDestinationFile
            Else
                UploadFile = strSourceFile
            End If
            
        End If
    End With
    
ExitHere:
    Set FSO = Nothing
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description, vbInformation, "Promt"
    Resume ExitHere
End Function

Private Sub Change_Click()
  
    Dim strDestinationPath As String
    Dim strReturnFile As String
    
    strDestinationPath = CurrentProject.Path & "\Picture"
    
    If Dir(strDestinationPath, vbDirectory) = "" Then
        MkDir (strDestinationPath)
    Else
    End If
    
    strReturnFile = UploadFile(strDestinationPath & "\", acPicture, True)

    If Len(strReturnFile) > 0 Then
        Me.Sketch = strReturnFile
        Me.imgPicture.Picture = strReturnFile
    End If

End Sub

Application.FileDialog([B][COLOR="Red"]2[/COLOR][/B])