كيف أصمم عداد للسجلات التي ادخلتها ؟

[النائف]

السلام عليكم

أخواني اقوم بالعمل على بيانات كبيرة

وبعض الأوامر تستغرق ساعات لتنفيذ

مثل اضافة مائة الف سجل او التعديل

وسؤالي كيف يمكن عمل عداد يوضح لي كم تم تنفيذه

حاولت بطرق كثيرة لكن بدون فائدة

أتمنى المساعدة :)

[ابو اسامة العينبوسي]

السلام عليكم

ارفق ملف اخي حتى يتسنى الاطلاع عليه

[النائف]

هذا كود يقوم بنسخ من جدول الى جدول بشروط معينه

عدد السجلات الناتج عن هذا كبير

كيف يمكن عمل نافذة توضح حال التنفيذ

Public Sub CreateFile()
v_HEAD = "H0122006122400001TESTIPO"
v_SUBSCRIPTION_DATE = "20061424"
v_RECEIVER_ID = "014"
v_CHANNEL_ID = "00024"
v_CHEQUE_NUMBER = " "
v_CREATION_TS = "20061224193600"
v_PORTFOLIO_NUMBER = "14"
v_app = 24000001
v_id = 104000001
v_dep = 144000001

DoCmd.RunSQL ("DELETE * FROM FORMATED")
Dim S, S2, S3, S4, S5, D1 As String
Dim v_count, v_shar, v_value As Double
Dim db As Database
Dim Rec_from, Rec_to As Recordset
Dim dat(49) As String
S1 = ""
S2 = ""
S3 = ""
S4 = ""
S5 = ""
D1 = ""

Set db = CurrentDb()
Set Rec_to = db.OpenRecordset("FORMATED")
Rec_to.AddNew
Rec_to!FORMATED_LINE = v_HEAD
Rec_to.Update

For t = 1 To 25
Set Rec_from = db.OpenRecordset("SELECT * FROM xxxHDR ", dbOpenDynaset, dbReadOnly)
Rec_from.MoveFirst

Do While Rec_from.EOF <> True
    v_app = v_app + 1
    v_id = v_id + 1
    For i = 1 To 46
        If IsNull(Rec_from(i)) Then
        dat(i - 1) = " "
        Else
        dat(i - 1) = Rec_from(i)
        End If
    Next i
    dat(3) = Mid(GenSubNo(Str(v_app)), 1, 9)
    dat(13) = Mid(Get_ID(Str(v_id)), 1, 10)
    v_ran = Int((20 * Rnd) + 1) * 10
    S1 = FillTxt(dat(0), " ", 1, "R") & FillTxt(dat(1), " ", 1, "R") & FillTxt(dat(2), " ", 12, "R") & FillTxt(dat(3), "0", 10, "L") & FillTxt(v_SUBSCRIPTION_DATE, " ", 8, "R") & FillTxt(v_RECEIVER_ID, "0", 3, "L") & FillTxt(v_CHANNEL_ID, "0", 5, "L") & FillTxt(dat(7), " ", 40, "R") & FillTxt(dat(8), " ", 40, "R") & FillTxt(dat(9), " ", 40, "R") & FillTxt(dat(10), " ", 40, "R")
    S2 = FillTxt(dat(11), " ", 40, "R") & FillTxt(dat(12), " ", 1, "R") & FillTxt(dat(13), " ", 15, "R") & FillTxt(dat(14), " ", 1, "R") & FillTxt(dat(15), " ", 1, "R") & FillTxt(dat(16), " ", 8, "R") & FillTxt(dat(17), " ", 25, "R") & FillTxt(dat(18), " ", 1, "R") & FillTxt(dat(19), " ", 10, "R") & FillTxt(dat(20), " ", 40, "R")
    S3 = FillTxt(dat(21), " ", 25, "R") & FillTxt(dat(22), " ", 2, "R") & FillTxt(dat(23), " ", 10, "R") & FillTxt(dat(24), " ", 20, "R") & FillTxt(dat(25), " ", 20, "R") & FillTxt(dat(26), "0", 3, "L") & FillTxt(v_ran, "0", 10, "L") & FillTxt((v_ran * Val(dat(26))), "0", 10, "L") & FillTxt((v_ran * Val(dat(26))) * 10, "0", 13, "L") & FillTxt(dat(30), " ", 1, "R")
    S4 = FillTxt(v_CHEQUE_NUMBER, " ", 10, "L") & FillTxt(dat(32), "0", 20, "L") & FillTxt(dat(33), " ", 40, "R") & FillTxt(dat(34), " ", 15, "R") & FillTxt(dat(35), " ", 1, "R") & FillTxt(dat(36), " ", 40, "R") & FillTxt(dat(37), " ", 10, "R") & FillTxt(dat(38), " ", 25, "R") & FillTxt(dat(39), " ", 2, "R") & FillTxt(dat(40), " ", 10, "R")
    S5 = FillTxt(dat(41), " ", 20, "R") & FillTxt(dat(42), " ", 20, "R") & FillTxt(dat(43), " ", 10, "R") & FillTxt(v_CREATION_TS, " ", 14, "R") & FillTxt(v_PORTFOLIO_NUMBER, "0", 10, "L")

    If Val(dat(26)) > 1 Then
        D1 = ""
        Set Rec_dep = db.OpenRecordset("SELECT * FROM xxxDTL WHERE SUBSCRIBER_POI ='" & Rec_from.SUBSCRIBER_POI & "'", dbOpenDynaset, dbReadOnly)
        Rec_dep.MoveFirst
        
        Do While Rec_dep.EOF <> True
            v_dep = v_dep + 1
            v_deps = Mid(Get_ID(Str(v_dep)), 1, 9)
            D1 = D1 & FillTxt(v_deps, " ", 15, "R") & FillTxt(Rec_dep(2), " ", 40, "R") & FillTxt(Rec_dep(3), " ", 1, "R")
            Rec_dep.MoveNext
        Loop
        
        Rec_dep.Close
        Else
        D1 = ""
    End If
    
    Rec_to.AddNew
    Rec_to!FORMATED_LINE = S1 + S2 + S3 + S4 + S5 + D1
    Rec_to.Update
    v_count = v_count + 1
    v_shar = v_shar + v_ran * Val(dat(26))
    v_value = v_value + v_ran * Val(dat(26)) * 10
    
    Rec_from.MoveNext
Loop
Rec_from.Close
Next t
Rec_to.AddNew
Rec_to!FORMATED_LINE = "D" & FillTxt(Str(v_count), "0", 8, "L") & FillTxt(Str(v_shar), "0", 10, "L") & FillTxt(Str(v_value), "0", 15, "L")
Rec_to.Update
Rec_to.Close
MsgBox "Done"

End Sub

تم تعديل ديسمبر 11, 2006 بواسطه النائف