مرفق بآلية الربط بالقواعد اكسس مجزء فقط اختيار السنة مع طلب

[hanan_ms]

11 hours ago, Foksh said:

استفساري بسيط ولكن للآن ما فهمت اسم الأداة و وظيفتها 😬

هي دالة حذف  ملف اذا تجاوزة عدد المسار اكثر من 255 😁

الدالة :

'============================= (Fix For Long path 255 , Start path Add "\\?\" (Allright I found an answer! Windows can only handle paths under 255 characters.))
  Public Function Deltet_Folder(ByVal strname As String) As String
  On Error GoTo Lerr
 Dim FX As Object
 Dim FXX As Object
   Set FX = CreateObject("scripting.filesystemobject")
   Set FXX = CreateObject("scripting.filesystemobject")

Dim STX_Server      As String
STX_Server = "\\?\"
Deltet_Folder = STX_Server & (strname)

FX.FolderExists (Deltet_Folder)
FXX.DeleteFolder (Deltet_Folder)

Lerr:
    MsgBox Err.Description
    Exit Function

End Function

طريقة الاستدعاء حدث عند النقر :

كود :

Dim path_xc As String
path_xc = Application.CurrentProject.path & "\ID_Card_record"
Deltet_Folder (path_xc)

اذا تبي للشبكة عدل على كود 

STX_Server

11 hours ago, Foksh said:

كأداة شبكة القواعد بيانات بنطاق الجغرافي

صحيح انت اردني سلو باي حاقة هو نفسه JFR K 

Jok 😂

هي ادادة انشاء وتأسيس وادارة قواعد البيانات بنطاق الجغرافي

هو صحيح لم اكمل بالكامل 

تفريع الملفات عند اضافة الرقم المدني القومي بأسم سنة الميلاد نفترض 1904 كمثال

ملف السنة الميلادية  (A)

داخل ملف المنطقة (B)

قاعدة البيانات المراجع  (C)

C:\path\A\B\C

=================(Net)

$ C:\path\A\B\C

'  طبعا القواعد الخلفية يفضل وتكون داخل جهاز وحدة التخزين لكامل ناطحة السحاب وتعمل بالانترنت مشفر وسريع كمل في البيت من غير تكالف مادية اضافية كموقع واشتراك 

استاذ @Foksh شنو تعقيبك على الاداة اذا كنت فاهم😇

[hanan_ms]

الاداة مفتوحة المصدر 😎

 يمكنك التعديل وتقديم الحلول والاقتراحات 

==================================================

الان لاداعي بجعل البرنامج جنب سطح المكتب

تم ادراج الدالة داخل الفورم (شاهد الفيديو)

==================================================😎

1- تصحيح بتغير الى رقم مع تصفير والتأسيس  

2-  اضافة بعض المعلومات حول العدد الاقصى كحد لعدد الملفات في الملف الواحد بالويندوز

3- %اضافة شريط تقدم من غير الوقت للعرض صفحات الانترنت عند انتقال وعند الاكتمال وعند تغير التقدم 100 

كود داخل المرفق

تحميل المرفق

https://www.mediafire.com/file/14h58cyxm79wqwv/FIX_AT_Update_And_ADD_New_Link_db_Ms_Accesss.rar/file

[Foksh]

21 ساعات مضت, hanan_ms said:

اذا كنت فاهم

🤦🏻‍♂️

[hanan_ms]

تحديث المرحلة الثانية

 

الاداة مفتوحة المصدر 😎

 يمكنك التعديل وتقديم الحلول والاقتراحات 

==================================================

1-FolderA\FolderB\File_ID

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

3-  تحكم بعدد الملفات = بسجلات مع تخصيص الفرعي 

 مراجعة دالة جلب عدد الملفات في الملف الواحد  

For Run Code : / part New Folder part YYYY_2 / woman/ File_ID = Complete

بتحديث لو حركة العنصر 

IMG.Png = No Any Flash query And move reboot  On way = No AnyFlash query  

====================================

للتعقيب والاقتراحات 

[hanan_ms]

تحديث المرحلة الثانية

 

الاداة مفتوحة المصدر 😎

 يمكنك التعديل وتقديم الحلول والاقتراحات 

==================================================

 * تحكم بعدد الملفات = بسجلات مع تخصيص الفرعي * 

1- اضافة حد لعدد الملفات في القاعدة المرتبطة عند الوصول تضيف قاعدة التالية جديدة مع الربط والاضافة 

2- اضافة شريط الانتظار حجمة وبيانات العرض طبقا للجدول  😁

كود:

If Me.HL = 1 Then
         Dim Loading As Integer
         Dim tablt_count As Integer
         
    Static intCount As Integer
    On Error Resume Next
    intCount = intCount + 10
    Me.ProgressBar1.Value = intCount
    
    tablt_count = DCount("[ID]", "[ID_Card_0]")
'=================================================
    Me.ProgressBar1.max = tablt_count * 10
'=================================================
    For Loading = 1 To tablt_count
    If intCount = Loading * 10 Then
         Me.SE.Caption = Loading * 10 & "% - ( Scan db - " & Loading & " )"
    Else
End If
Next
Else
     Me.SE.Caption = "0%"
intCount = 0
End If

3- تعديل على بعض وتصحيح

دالة لتحديد قراءة بطاقة المدنية القومية حصر بين الجهتين للقراءة :

    Public Function yyx1(ByVal strname_y1 As String) As String
    Dim yx1 As Long
        If IsNull(DLookup("[yy2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[yy2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    yx1 = 1
    Else
yx1 = DLookup("[yy2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

yyx1 = Left(strname_y1, InStrRev(strname_y1, "") - yx1)
End Function
Public Function yyx2(ByVal strname_y2 As String) As String
    Dim yx2 As Long
        If IsNull(DLookup("[yy1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[yy1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    yx2 = 1
    Else
yx2 = DLookup("[yy1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

yyx2 = Right(strname_y2, InStrRev(strname_y2, "") - yx2)
End Function

    Public Function mmx1(ByVal strname_m1 As String) As String
    Dim mx1 As Long
        If IsNull(DLookup("[mm2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[mm2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    mx1 = 1
    Else
mx1 = DLookup("[mm2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

mmx1 = Left(strname_m1, InStrRev(strname_m1, "") - mx1)
End Function
Public Function mmx2(ByVal strname_m2 As String) As String
    Dim mx2 As Long
        If IsNull(DLookup("[mm1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[mm1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    mx2 = 1
    Else
mx2 = DLookup("[mm1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If
'On Error Resume Next  ' =============== Null whrer bit
mmx2 = Right(strname_m2, InStrRev(strname_m2, "") - mx2)
End Function

    Public Function ddx1(ByVal strname_d1 As String) As String
    Dim dx1 As Long
        If IsNull(DLookup("[dd2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[dd2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    dx1 = 1
    Else
dx1 = DLookup("[dd2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

ddx1 = Left(strname_d1, InStrRev(strname_d1, "") - dx1)
End Function
Public Function ddx2(ByVal strname_d2 As String) As String
    Dim dx2 As Long
        If IsNull(DLookup("[dd1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[dd1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    dx2 = 1
    Else
dx2 = DLookup("[dd1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

ddx2 = Right(strname_d2, InStrRev(strname_d2, "") - dx2)
End Function

    Public Function xxy1(ByVal strname_xy1 As String) As String
    Dim xy1 As Long
        If IsNull(DLookup("[xy2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[xy2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    xy1 = 1
    Else
xy1 = DLookup("[xy2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

xxy1 = Left(strname_xy1, InStrRev(strname_xy1, "") - xy1)
End Function
Public Function xxy2(ByVal strname_xy2 As String) As String
    Dim xy2 As Long
        If IsNull(DLookup("[yx1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[yx1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    xy2 = 1
    Else
xy2 = DLookup("[yx1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

xxy2 = Right(strname_xy2, InStrRev(strname_xy2, "") - xy2)
End Function

    Public Function sexx1(ByVal strname_SX1 As String) As String
    Dim sx1 As Long
        If IsNull(DLookup("[sex2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[sex2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    sx1 = 1
    Else
sx1 = DLookup("[sex2]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

sexx1 = Left(strname_SX1, InStrRev(strname_SX1, "") - sx1)
End Function
Public Function sexx2(ByVal strname_SX2 As String) As String
    Dim sx2 As Long
        If IsNull(DLookup("[sex1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")) Or DLookup("[sex1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ") = "" Then
    sx2 = 1
    Else
sx2 = DLookup("[sex1]", "[Cantry_ID]", " [name_Cantry] ='" & [Forms]![Add_User_db_0]![G] & "' ")
End If

sexx2 = Right(strname_SX2, InStrRev(strname_SX2, "") - sx2)
End Function

 

 

تحميل نسخة من الاداة 

 

https://www.mediafire.com/file/egiq66urggilbrk/Functon_Read_XIDcard+_with_Limte_db_Siz_MsAceess.rar/file