كود عمل نسخة باك اب للملف مع كتابة رقم النسخة

[ehabaf2]

السلام عليكم السادة الخبراء الافاضل

محتاج كود عمل نسخة باك اب للملف باسم Ehab مكان الحفظ نفس المجلد 

عند كل مرة اقوم بعمل باك اب يكتب يضيف رقم الباك اب مثلا اول مرة Ehab1 ; Ehab2 : Ehab3 و هكذا يزيد رقم عند عمل الباك اب لنعرف ان الرقم الكبير احدث باك اب و الكود ينفذ عند الضغط على زر

الف الف شكرا لحضراتكم

مرفق ملف فارغ باسم Ehab للتجربة

 

Ehab.xlsx

[عبدالله بشير عبدالله]

وعليكم السلام ورحمة الله وبركاته 

الكود

Sub CreateBackup()
    Dim wb As Workbook
    Dim folderPath As String
    Dim fileName As String
    Dim fileExtension As String
    Dim backupName As String
    Dim backupNumber As Integer
    Dim fso As Object
    Dim file As Object

    Set wb = ThisWorkbook
    folderPath = wb.Path & "\"
    fileName = Left(wb.Name, InStrRev(wb.Name, ".") - 1)
    fileExtension = Mid(wb.Name, InStrRev(wb.Name, "."))
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    backupNumber = 0
    
    For Each file In fso.GetFolder(folderPath).Files
        If InStr(file.Name, fileName) = 1 And InStr(file.Name, fileExtension) > 0 Then
            Dim currentNumber As Integer
            On Error Resume Next
            currentNumber = CInt(Mid(file.Name, Len(fileName) + 1, InStrRev(file.Name, fileExtension) - Len(fileName) - 1))
            On Error GoTo 0
            If currentNumber > backupNumber Then
                backupNumber = currentNumber
            End If
        End If
    Next file

    backupName = folderPath & fileName & (backupNumber + 1) & fileExtension
    wb.SaveCopyAs backupName

    MsgBox "تم إنشاء نسخة احتياطية باسم: " & vbCrLf & backupName, vbInformation, "نسخة احتياطية"
End Sub

الملف

Ehab.xlsb

[ehabaf2]

الاستاذ الفاضل @عبدالله بشير عبدالله

الكود يعمل و ينفذ المطلوب الف الف شكر لحضرتك