مشكلة في ضغط قاعدة البيانات المرتبطة

[Moh88nad]

شباب اريد طريقة لضغط قاعدة البيانات النرتبطة من خلال كود VBA  والكود ياخد تلقئي مسار القاعدة

تم تعديل أغسطس 27, 2020 بواسطه Moh88nad

[محمد أبوعبدالله]

تفضل وجدت لك هذا المثال

zaCompactAndRepairSplitDatabase.rar

تحياتي

[د.كاف يار]

تفضل هذا الكود اخي الكري مع مراعاة التغيير حسب المتغيرات الاسم و صيغة قاعدة البيانات

كما يمكنك تثبيت موقع قاعدة البيانات من خلال تثبيت القيمة للمتغيير strBEFileSpec1

On Error GoTo errorhandle
Dim varThis As Variant
  Dim strBEFileSpec1 As String
 Dim TabolPath, DataTayb As String
 TabolPath = "TabelName"
 DataTay = ".mdb"
  strBEFileSpec1 = Application.CurrentProject.Path & "\" & TabolPath & DataTay
 
    For Each varThis In CurrentDb.TableDefs
      With varThis
        If Trim(Nz(.Connect)) Like ";DATABASE=*" Then
          .Connect = ";DATABASE=" & strBEFileSpec1
          .RefreshLink
        End If
      End With
    Next varThis
 
      Next varThis
    MsgBox "تم ربط قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تأكيد الربط"

errorhandleexit:
        Exit Sub
errorhandle:
        MsgBox Err.Description
        Resume errorhandleexit

 

تم تعديل أغسطس 27, 2020 بواسطه د.كاف يار

[Moh88nad]

أخي محمد أبوعبد الله هذا المثال لايعمل لان النظام عندي 64 بت

7 ساعات مضت, محمد أبوعبدالله said:

تفضل وجدت لك هذا المثال

zaCompactAndRepairSplitDatabase.rar 25.36 kB · 2 تنزيلات

تحياتي

أخي محمد هذا المثال لايعمل لان النظام لدي 64 يت

 

7 ساعات مضت, د.كاف يار said:

تفضل هذا الكود اخي الكري مع مراعاة التغيير حسب المتغيرات الاسم و صيغة قاعدة البيانات

كما يمكنك تثبيت موقع قاعدة البيانات من خلال تثبيت القيمة للمتغيير strBEFileSpec1

On Error GoTo errorhandle
Dim varThis As Variant
  Dim strBEFileSpec1 As String
 Dim TabolPath, DataTayb As String
 TabolPath = "TabelName"
 DataTay = ".mdb"
  strBEFileSpec1 = Application.CurrentProject.Path & "\" & TabolPath & DataTay
 
    For Each varThis In CurrentDb.TableDefs
      With varThis
        If Trim(Nz(.Connect)) Like ";DATABASE=*" Then
          .Connect = ";DATABASE=" & strBEFileSpec1
          .RefreshLink
        End If
      End With
    Next varThis
 
      Next varThis
    MsgBox "تم ربط قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تأكيد الربط"

errorhandleexit:
        Exit Sub
errorhandle:
        MsgBox Err.Description
        Resume errorhandleexit

 

أخي هذا الكود لربط القاعدة وليس لضغطها على حسب فهمي للكود

 

[د.كاف يار]

ضغط و اصلاح قاعدة البيانات 

في الازرار حدث عند الضغط

SendKeys "{F10}"
SendKeys "]sq"
SendKeys "{F10}"
SendKeys "tdc"