aecc

مبارك عليكم شهر رمضان  

شكرا لك اخي على توجيهاتك

اما عن حل المشكله فهي تظهر في بعض الاجهزة دون البعض الاخر

ان شاء الله يلهمنا الحل

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

الحل

اولا

تعديل المكتبات كما في الصورة

ثانيا

تغيير

Dim dbs As Database

الى 

Dim dbs as DAO.Database

تخرج هذه الرسالة عند اضافة المكتبة

هنا المشاكل

module.rar

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

ولم تظهر المشكلة الا عند التحويل من 

(mdb)

الى

(accdb)

الكود الثاني😇

ها هي المكتبات

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

عانيت مؤخرا عند تحويل الملفات من التنسيق القديم للجديد في اكسس ان بعض الاكواد التي تعمل مع الامتداد

(mdb)

لم تعمل على الامتداد

(accdb)

فلماذا

جزاكم الله كل الخير على المساعدة

السلام عليكم

شكرا للرد

اظن جزء منه بالفعل للاخ العملاق رضا عقيل جزاه الله كل الخير وكذالك اجزاء من المبدعة الاستاذة زهرة العبدالله

ولكن كان ذلك منذ اكثر من 17 عام 

ماذا تعني برابط الموضوع؟

اذا كنت تسأل عن الكود فهو من تجميعي من مواضيع عديدة

كنت عضوا قديما في هذا المنتدى وكذلك منتدى المحيط العربي للبرمجه ولكن غلبنا العمر الله المعين

شكرا على الاهتمام

ولكن لم يعمل

 اذا حضرتك ممكن تغير الكود فلتفعل 

على ان يقوم بنفس الوظائف

تفضل اخي

Hdd Copy - Copy.accdb

اردت تعديل نفس الكود لاني اقتطعته من باقي الكود حيث فيه تشفير وكذلك ربط بتاريخ التسجيل اما مجرد اظهار رقم الهارد فهو امر سهل ان شاء الله

وجزاك الله خيرا على اجابتكم كما لا اريد ان اثقل عليكم

جيد جزيت الجنة

عفوا لم لا استطيع تحميل اي ملف ؟

جزاك الله خيرا

صحيح ابا جودي ولكنه لم يعد يعمل على الاجهزة الحديثة

لم لا استطيع تحميل الملف؟

شكرا اخي ولكن

هل يمكن تعديل نفس الكود

Option Compare Database
Option Explicit

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1
Private Const INVALID_HANDLE_VALUE = -1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const IDENTIFY_BUFFER_SIZE = 512
Private Const OUTPUT_DATA_SIZE = IDENTIFY_BUFFER_SIZE + 16

Private Type GETVERSIONOUTPARAMS
   bVersion       As Byte
   bRevision      As Byte
   bReserved      As Byte
   bIDEDeviceMap  As Byte
   fCapabilities  As Long
   dwReserved(3)  As Long
End Type

Private Type IDEREGS
   bFeaturesReg     As Byte
   bSectorCountReg  As Byte
   bSectorNumberReg As Byte
   bCylLowReg       As Byte
   bCylHighReg      As Byte
   bDriveHeadReg    As Byte
   bCommandReg      As Byte
   bReserved        As Byte
End Type

Private Type SENDCMDINPARAMS
   cBufferSize     As Long
   irDriveRegs     As IDEREGS
   bDriveNumber    As Byte
   bReserved(2)    As Byte
   dwReserved(3)   As Long
   bBuffer()      As Byte
End Type

Private Const IDE_ID_FUNCTION = &HEC
Private Const IDE_EXECUTE_SMART_FUNCTION = &HB0
                                               
                                               

Private Const SMART_CYL_LOW = &H4F
Private Const SMART_CYL_HI = &HC2

Private Type DRIVERSTATUS
   bDriverError  As Byte
   bIDEStatus    As Byte
                                  
   bReserved(1)  As Byte
   dwReserved(1) As Long
 End Type

Private Type IDSECTOR
   wGenConfig                 As Integer
   wNumCyls                   As Integer
   wReserved                  As Integer
   wNumHeads                  As Integer
   wBytesPerTrack             As Integer
   wBytesPerSector            As Integer
   wSectorsPerTrack           As Integer
   wVendorUnique(2)           As Integer
   sSerialNumber(19)          As Byte
   wBufferType                As Integer
   wBufferSize                As Integer
   wECCSize                   As Integer
   sFirmwareRev(7)            As Byte
   sModelNumber(39)           As Byte
   wMoreVendorUnique          As Integer
   wDoubleWordIO              As Integer
   wCapabilities              As Integer
   wReserved1                 As Integer
   wPIOTiming                 As Integer
   wDMATiming                 As Integer
   wBS                        As Integer
   wNumCurrentCyls            As Integer
   wNumCurrentHeads           As Integer
   wNumCurrentSectorsPerTrack As Integer
   ulCurrentSectorCapacity    As Long
   wMultSectorStuff           As Integer
   ulTotalAddressableSectors  As Long
   wSingleWordDMA             As Integer
   wMultiWordDMA              As Integer
   bReserved(127)             As Byte
End Type

Private Type SENDCMDOUTPARAMS
  cBufferSize   As Long
  DRIVERSTATUS  As DRIVERSTATUS
  bBuffer()    As Byte
End Type

Private Const SMART_ENABLE_SMART_OPERATIONS = &HD8

Public Enum STATUS_FLAGS
   PRE_FAILURE_WARRANTY = &H1
   ON_LINE_COLLECTION = &H2
   PERFORMANCE_ATTRIBUTE = &H4
   ERROR_RATE_ATTRIBUTE = &H8
   EVENT_COUNT_ATTRIBUTE = &H10
   SELF_PRESERVING_ATTRIBUTE = &H20
End Enum

Private Const DFP_GET_VERSION = &H74080
Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088

Private Type ATTR_DATA
   AttrID As Byte
   AttrName As String
   AttrValue As Byte
   ThresholdValue As Byte
   WorstValue As Byte
   StatusFlags As STATUS_FLAGS
End Type

Private Type DRIVE_INFO
   bDriveType As Byte
   SerialNumber As String
   Model As String
   FirmWare As String
   Cilinders As Long
   Heads As Long
   SecPerTrack As Long
   BytesPerSector As Long
   BytesperTrack As Long
   NumAttributes As Byte
   Attributes() As ATTR_DATA
End Type

Private Enum IDE_DRIVE_NUMBER
   PRIMARY_MASTER
   PRIMARY_SLAVE
   SECONDARY_MASTER
   SECONDARY_SLAVE
   TERTIARY_MASTER
   TERTIARY_SLAVE
   QUARTIARY_MASTER
   QUARTIARY_SLAVE
End Enum

Private Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   lpSecurityAttributes As Any, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long
  
Private Declare Function DeviceIoControl Lib "kernel32" _
  (ByVal hDevice As Long, _
   ByVal dwIoControlCode As Long, _
   lpInBuffer As Any, _
   ByVal nInBufferSize As Long, _
   lpOutBuffer As Any, _
   ByVal nOutBufferSize As Long, _
   lpBytesReturned As Long, _
   lpOverlapped As Any) As Long
  
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (hpvDest As Any, _
   hpvSource As Any, _
   ByVal cbCopy As Long)
  
Private Type OSVERSIONINFO
   OSVSize As Long
   dwVerMajor As Long
   dwVerMinor As Long
   dwBuildNumber As Long
   PlatformID As Long
   szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
  (LpVersionInformation As OSVERSIONINFO) As Long

Sub ShowMoreDriveInfo()
'
On Error GoTo ErrMsg
ShowAllDriveInfo ("C:")
'
Exit Sub
'
ErrMsg:
MsgBox Err.Description
End Sub
'
'
Sub ShowAllDriveInfo(DriveName As String)
'
Dim Drive As Object, Info As String, DriveTypeIs As String
'
Set Drive = CreateObject("Scripting.FileSystemObject").GetDrive(DriveName)
'
Select Case Drive.DriveType
Case 0: DriveTypeIs = "Unknown"
Case 1: DriveTypeIs = "Removable"
Case 2: DriveTypeIs = "Fixed"
Case 3: DriveTypeIs = "Network"
Case 4: DriveTypeIs = "CD-ROM"
Case 5: DriveTypeIs = "RAM Disc"
End Select
'
If Drive.VolumeName = Empty Then Drive.VolumeName = "(di)"
Info = "Drive " & Drive.DriveLetter & ": " & vbNewLine & _
"Drive Type: " & DriveTypeIs & vbNewLine & _
"Drive Name: " & Drive.VolumeName & vbNewLine & _
"Total Size: " & FormatNumber(Drive.TotalSize / 1024, 0) & " Kbytes" & vbNewLine & _
"Available Space: " & FormatNumber(Drive.AvailableSpace / 1024, 0) & " Kbytes"
'
If Drive.IsReady Then Info = Info & vbNewLine & "Drive " & Drive.DriveLetter & " is Ready."
'
MsgBox Info
'
Set Drive = Nothing

'
End Sub
Private Function GetDriveInfo(drvNumber As IDE_DRIVE_NUMBER) As DRIVE_INFO
    
   Dim hDrive As Long
   Dim di As DRIVE_INFO
   
   hDrive = SmartOpen(drvNumber)
   
   If hDrive <> INVALID_HANDLE_VALUE Then
   
      If SmartGetVersion(hDrive) = True Then
      
         With di
            .bDriveType = 0
            .NumAttributes = 0
            ReDim .Attributes(0)
            .bDriveType = 1
         End With
         
         If SmartCheckEnabled(hDrive, drvNumber) Then
            
            If IdentifyDrive(hDrive, IDE_ID_FUNCTION, drvNumber, di) = True Then
         
            GetDriveInfo = di
               
            End If
         End If
      End If
   End If
   
   CloseHandle hDrive
   
End Function

Private Function IdentifyDrive(ByVal hDrive As Long, _
                               ByVal IDCmd As Byte, _
                               ByVal drvNumber As IDE_DRIVE_NUMBER, _
                               di As DRIVE_INFO) As Boolean
    
 
   Dim SCIP As SENDCMDINPARAMS
   Dim IDSEC As IDSECTOR
   Dim bArrOut(OUTPUT_DATA_SIZE - 1) As Byte
   Dim cbBytesReturned As Long
   
   With SCIP
      .cBufferSize = IDENTIFY_BUFFER_SIZE
      .bDriveNumber = CByte(drvNumber)
        
      With .irDriveRegs
         .bFeaturesReg = 0
         .bSectorCountReg = 1
         .bSectorNumberReg = 1
         .bCylLowReg = 0
         .bCylHighReg = 0
         .bDriveHeadReg = &HA0
         If Not IsWinNT4Plus Then
            .bDriveHeadReg = .bDriveHeadReg Or ((drvNumber And 1) * 16)
         End If
        
         .bCommandReg = CByte(IDCmd)
      End With
   End With
   
   If DeviceIoControl(hDrive, _
                      DFP_RECEIVE_DRIVE_DATA, _
                      SCIP, _
                      Len(SCIP) - 4, _
                      bArrOut(0), _
                      OUTPUT_DATA_SIZE, _
                      cbBytesReturned, _
                      ByVal 0&) Then
                      
      CopyMemory IDSEC, bArrOut(16), Len(IDSEC)

      di.Model = StrConv(SwapBytes(IDSEC.sModelNumber), vbUnicode)
      di.SerialNumber = StrConv(SwapBytes(IDSEC.sSerialNumber), vbUnicode)
      
      IdentifyDrive = True
      
    End If
    
End Function

Private Function IsWinNT4Plus() As Boolean

  
   Dim osv As OSVERSIONINFO

   osv.OSVSize = Len(osv)

   If GetVersionEx(osv) = 1 Then
   
      IsWinNT4Plus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _
                     (osv.dwVerMajor >= 4)
 
   End If

End Function

Private Function SmartCheckEnabled(ByVal hDrive As Long, _
                                   drvNumber As IDE_DRIVE_NUMBER) As Boolean
   
  
   Dim SCIP As SENDCMDINPARAMS
   Dim SCOP As SENDCMDOUTPARAMS
   Dim cbBytesReturned As Long
   
   With SCIP
   
      .cBufferSize = 0
      
      With .irDriveRegs
           .bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
           .bSectorCountReg = 1
           .bSectorNumberReg = 1
           .bCylLowReg = SMART_CYL_LOW
           .bCylHighReg = SMART_CYL_HI

           .bDriveHeadReg = &HA0
            If Not IsWinNT4Plus Then
               .bDriveHeadReg = .bDriveHeadReg Or ((drvNumber And 1) * 16)
            End If
           .bCommandReg = IDE_EXECUTE_SMART_FUNCTION
           
       End With
       
       .bDriveNumber = drvNumber
       
   End With
   
   SmartCheckEnabled = DeviceIoControl(hDrive, _
                                      DFP_SEND_DRIVE_COMMAND, _
                                      SCIP, _
                                      Len(SCIP) - 4, _
                                      SCOP, _
                                      Len(SCOP) - 4, _
                                      cbBytesReturned, _
                                      ByVal 0&)
End Function

Private Function SmartGetVersion(ByVal hDrive As Long) As Boolean
   
   Dim cbBytesReturned As Long
   Dim GVOP As GETVERSIONOUTPARAMS
   
   SmartGetVersion = DeviceIoControl(hDrive, _
                                     DFP_GET_VERSION, _
                                     ByVal 0&, 0, _
                                     GVOP, _
                                     Len(GVOP), _
                                     cbBytesReturned, _
                                     ByVal 0&)
   
End Function

Private Function SmartOpen(drvNumber As IDE_DRIVE_NUMBER) As Long

   If IsWinNT4Plus() Then
      
      SmartOpen = CreateFile("\\.\PhysicalDrive" & CStr(drvNumber), _
                             GENERIC_READ Or GENERIC_WRITE, _
                             FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                             ByVal 0&, _
                             OPEN_EXISTING, _
                             0&, _
                             0&)

   Else
      
      SmartOpen = CreateFile("\\.\SMARTVSD", _
                              0&, 0&, _
                              ByVal 0&, _
                              CREATE_NEW, _
                              0&, _
                              0&)
   End If
   
End Function

Private Function SwapBytes(b() As Byte) As Byte()
   
  
   
   Dim bTemp As Byte
   Dim cnt As Long

   For cnt = LBound(b) To UBound(b) Step 2
      bTemp = b(cnt)
      b(cnt) = b(cnt + 1)
      b(cnt + 1) = bTemp
   Next cnt
      
   SwapBytes = b()
      
End Function

Private Sub cmdClose_Click()
DoCmd.Quit acQuitSaveAll
End Sub

Private Sub Form_Load()
Me.lic = DLookup("[lic]", "serial_h")
  
  Dim di As DRIVE_INFO
  Dim drvNumber As Long
 
  di = GetDriveInfo(drvNumber)
  With di
  Select Case .bDriveType
           
       Case 0
       Me.text05.Value = "[Not present]"
           Case 1
           Me.text05.Value = Trim$(.SerialNumber)
                Dim rep, irep As Integer
                Dim asp, ass, dg, df As String
                dg = 0
                For irep = 1 To Len(Trim$(.SerialNumber))
                asp = mID((Trim$(.SerialNumber)), irep, 1)
                If IsNumeric(asp) = True Then
                ass = dg & asp
                dg = ass
                End If
                Next irep
                '''''''''''''''''''
                df = ""
                For irep = 1 To Len(Trim$(.SerialNumber))
                asp = mID((Trim$(.SerialNumber)), irep, 1)
                If IsNumeric(asp) = False Then
                ass = df & asp
                df = ass
                End If
                Next irep
                Me.text05 = Asc(df) & dg
                '''''''''''''''
           
           Case 2
           text05.Value = "[ATAPI drive - info not available]"
           Case Else
           text05.Value = "[drive type not known]"
           End Select
               End With

Err_hem:
Exit Sub

End Sub

السادة محترفي الاكسيس الرحاء تعديل كود تعديل كود للتعرف على رقم الهارد وهو كزد قديم نقلته من المنتدى ولكن الكود غير صالح للهاردات الجديدة 

ارجو تعديل الكود من اهل الخبرة

شاكرا اكم جخودكم

Hdd Copy.accdb

ماشاء الله ممتااااااااااااااااز

مشكورين يا اخوان

اخواني هذا الملف تم حل المشكلة به

من استمرت لديه المشكلة فيجب عليه ازالة الاوفيس والاكسس رن تايم وبعدها يعيد تنزيل الاوفيس كاملا

moqawlat.rar

لكن عندي يفتح بصورة طبيعية

ارجو من الاخوة الخبراء بحث المشكلة وسببها

ممكن توضح الخطأ لانه لايوجد خطأ عندي؟؟

الاسم (a)

كلمة المرور (1)

تم تعديل البرنامج ارجو من المشرفين ازالة جميع المرفقات السابقة حيث يمكن ان تتسبب في بعض المشاكل

البرنامج معدل بدون حماية فقط تسجيل الدخول a 1

البرنامج مرفق رقم 1

الشرح مرفق رقم 2

1.rar

2.rar

بسم الله الرحمن الرحيم

نأتي لشرح البرنامج حيث طلب من منتديات أخرى أن اشرحه

1-

الاسم (a)

كلمة المرور (1)

2- النافذة الرئيسية

نختار إضافات

أ‌- إضافة تصنيفات: لإضافة المواد وتصنيفاتها لاستعمالها في طلبات الشراء

ب‌- إضافة أعمال : لإضافة نوع الأمتار وسعر المتر لاستخدامها لحساب اجر العمال حال عملوا بالمتر

ت‌- إضافة جنسيات (مفهوم)

ث‌- بيانات المؤسسة (مفهوم)

3- نختار الموظفون

تفتح هذه النافذة حيث نلاحظ بعض الخانات الحمراء وتعني أن هناك مستندات تخص العمال قد انتهت (في حالة لم ينتهي أي شئ فلن تظهر هذه النافذة)

نغلق النافذة فتنفتح نافذة إدراج بيانات الموظفين آليا

طبعا تحتوي النافذة على طريقتين للبحث وبعض التقارير الرسمية المطلوبة لدي دائرة العمل في دولة الإمارات أترككم لاكتشافها

4- نختار إضافة مشاريع

لإضافة المشاريع وبياناتها

5- نختار الرواتب

يحتاج النموذج للفهم نلاحظ وجود تقسيمات أولا نختار رقم الموظف من الأعلى

نضيف رقم المشروع حتى لو غاب العامل

اسم الأستاذ اختياري

نضيف اليوم الأول فقط وباقي الأيام تدرج آليا

نلاحظ هنا أن العمال إما يعملون باليومية أو بالأمتار:

حالة اليومية

- بيان الأيام 1- يومية: أما 1 أو 0

2- ساعات : عدد الساعات

حالة الأمتار 1- أيام متر (=1 في حالة إن العامل عمل يوم كامل بالمتر)

2- نوع العامل: هي نسبة العامل من قيمة المتر: يعني لو أن المتر بـ 12 درهم وعمل فيه أستاذ وعامل وكان للأستاذ مثلا 60% وللعامل 40% من قيمة المتر فنضع هذه النسبة عشريا

3- نوع العمل : أي بلاط أو طابوق أو سيراميك ......................الخ

4 – عدد الأمتار

أما باقي الخانات فهي كالتالي

قيمة الإضافي (المكافأة)

قيمة الخصم

عدد أيام الغياب (أما مجملة تسجل مرة واحدة أو كل يوم على حدة)

طبعا يوجد تقرير للرواتب لعامل واحد أو تقرير شهري بالرواتب لكل العمال

ملاحظة يوحد تقرير رواتب آخر في الحسابات يوزع الرواتب على المشاريع

6- نختار القيود اليومية (مقتبس من البيان للمحاسبة مع إضافات بسيطة لتحليلي القيود)

اتركه لتكتشفوه

ملاحظه: يوجد زرين زر (V) لسندات القبض والصرف

زر (Det) لإضافة تحليلي القيد

7- نختار الحسابات: طبعا نظام محاسبي شبه كامل (أرجو دراسته إبداء الملاحظات لتطويره)

بقي العملاء والموردون

وطلبات الشراء أظن وبعض الأشياء الأخرى لا تحتاج لشرح

أرجو أن يغفر لنا الشرح ما حدث من أخطاء