تعديل على نموذج نسخ

ضع هذا الاجراء فى النموذج أو فى الوحدة النمطية

Sub Copy_Folder(FromPath As String, ToPath As String)
    Dim FSO As Object
    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If
    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
End Sub

و اضف هذا الكود الى كود الزر فى النموذج

Copy_Folder "D:\PIC", CurrentProject.Path & "\" & "copys\PIC"