استفسار حول كود استيراد بيانات من ملف اكسل

**ابو البشر** · مايو 8, 2020

السلام عليكم ورحمة الله وبركاته ..... جميع اعضاء المنتدى ..... كل عام وانتم بخير وأسأل الله عز وجل أن يتقبل منا ومنكم صالح الاعمال

استفسار حول كود سابق شارك في موضوعة في هذا الموضوع الأساتذة :

@فايز و @Barna و @jjafferr و @أبو إبراهيم الغامدي في هذا الموضوع ولدي عدد من الاستفسار على الكود التالي بارك الله فيكم :

Option Compare Database
Option Explicit

Sub IMPORT_XLSDB()
   On Error GoTo SUB_CLOSE
   
   '-- OPEN CURRENT DATABASE AS LOCAL DB
   Dim DB As DAO.Database
   Set DB = CurrentDb
   '-- OPEN RS DB TO ADD DATA
   Dim DBRS As DAO.Recordset
   Set DBRS = CurrentDb.OpenRecordset("TABLE")
   
   '-- OPEN XLS FILE AS REMOTE DATABASE
   Dim XLDB  As DAO.Database
   Set XLDB = OpenDatabase( _
   CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;")
   '-- OPEN XLS SHEET AS REMOTE RS
   Dim XLRS As DAO.Recordset
   Dim RCROW()
   Dim RC As Long
   Dim I As Integer
   Dim TD As DAO.TableDef
   '-- LOOP THROUGH XLDB TABLES (SHEETS)
   For Each TD In XLDB.TableDefs
   '-----------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (C) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
      '--------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (I) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
   Next
SUB_CLOSE:
   '-- COLOSE XLDB AND XLRS
   Set XLRS = Nothing
'   XLDB.Close
   Set XLDB = Nothing
   '------------------------'
   '-- CLOSE DB AND DBRS
   Set DBRS = Nothing
   XLDB.Close
   Set XLDB = Nothing
End Sub

1- ما المقصود في الاؤقام المسجلة في 1 و 2

2- ما المقصود ب F1 و هل يمكن تغيير النطاق في 4 وكيف يتم ذلك لو اغترضنا أن ملف الاكسل نريد جلب بيانات اكثر من عامود في الصفحة الواحدة دون تكرار للكود كما فعلنا في الكود السابق بمعنى بجلب بيانات العمود C والعمود I مباشرة أو حتى أكثر من عمودين ؟؟؟؟

بارك الله فيكم وفي علمكم ...

الموضوع هنا بارك الله فيكم

في ١١‏/٤‏/٢٠٢٠ at 21:27, أبو إبراهيم الغامدي said:
السلام عليكم..

أرى أن حواراً ممتعا دار في هذه المشاركة مما أثار رغبتي في المشاركة.. 😀

أرجو أن تجدوا في هذه المشاركة شيئاً جديداً ومميزاً.. 🤩

سوف نتعامل مع مصنف أكسل كقاعدة بيانات ولعمل ذلك نطبق الشفرة التالي
'-- OPEN XLS FILE AS REMOTE DATABASE
Dim XLDB  As DAO.Database
Set XLDB = OpenDatabase( _
CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;")
عند فتح مصنف أكسل كقاعدة بيانات سوف تصبح أوراق البيانات كجداول بيانات في أكسس، ولكي نتحقق من ذلك نستخدم الغرض TableDefs لسرد أسماء الجداول (أوراق البيانات)
'-- LOOP THROUGH XLDB TABLES (SHEETS)
For Each TD In XLDB.TableDefs
	TD.Name
Next
:: عند النظر إلى ورقة البيانات في مصنف البانات نجد البيانات محصورة في العمودين (C,I) والبيانات ليست متساوية الطول وبالتالي نحن بحاجة إلى جعل كل عمود جدول بيانات مستقل!

:: يوجد في مكون البيانات Recordset وظيفة اسمه Getrows تقوم بتجميع البيانات كمصفوفة بيانات يحدد طولها المستخدم حسب احتياجة. ولكون البيانات الطالب في ورقة البيانات تتكون من 5 صفوف؛ وبناءُ عليه سوف نقوم بتجميع البيانات على هذا الأساس. لكن يجب أن نقوم بأخذ عدد السجلات في الجدول (ورقة البيانات) والذي هو بالتأكيد من مضاعفات الـ(5).

الوظيفة Getrows تقوم بأخذ المجموع التالية من السجلات عن اطلاقها مرة أخرى وبالتالي نحن بحاجة إلى دوارة بطول السجلات وتقوم بالقفز كل 5 سجلات، بمعنى (20/5).

:: نقوم بعد ذلك بتسجيل البيانات في جدول الطلاب من مصفوفة البيانات التي تعيدها Getrows.

:: سوف تدور الشفرة على جميع الجداول (أوراق البيانات) وتكرر جلب البيانات مرتين حسب أعمدة البيانات التي سبق الإشارة إليها. كما أنها تقوم بحذف الصفوف الفارغة عند جلب البيانات.

الشفرة التالية توضح المبدأ السابق وطريقة نقل البيانات..
'-- LOOP THROUGH XLDB TABLES (SHEETS)
For Each TD In XLDB.TableDefs
'-----------------------------------------------------------------------------------------'
'-- RECORDS FROM COLUMN (C) IN XL SHEET
Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)")
'-- COUNT RECORDS
XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
'-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
For I = 1 To RC Step 5
RCROW = XLRS.GetRows(5)
DBRS.AddNew
  DBRS![ACADEMIC YEAR] = RCROW(0, 0)
  DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
  DBRS![STNAME] = RCROW(0, 2)
  DBRS![F1] = RCROW(0, 3)
  DBRS![Sub] = RCROW(0, 4)
DBRS.Update
Next
Set XLRS = Nothing
'--------------------------------------------------------------------------------------'
'-- RECORDS FROM COLUMN (I) IN XL SHEET
Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)")
'-- COUNT RECORDS
XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
'-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
For I = 1 To RC Step 5
RCROW = XLRS.GetRows(5)
DBRS.AddNew
  DBRS![ACADEMIC YEAR] = RCROW(0, 0)
  DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
  DBRS![STNAME] = RCROW(0, 2)
  DBRS![F1] = RCROW(0, 3)
  DBRS![Sub] = RCROW(0, 4)
DBRS.Update
Next
Set XLRS = Nothing
Next
إليكم الشفرة كاملة
Option Compare Database
Option Explicit

Sub IMPORT_XLSDB()
   On Error GoTo SUB_CLOSE
   
   '-- OPEN CURRENT DATABASE AS LOCAL DB
   Dim DB As DAO.Database
   Set DB = CurrentDb
   '-- OPEN RS DB TO ADD DATA
   Dim DBRS As DAO.Recordset
   Set DBRS = CurrentDb.OpenRecordset("TABLE")
   
   '-- OPEN XLS FILE AS REMOTE DATABASE
   Dim XLDB  As DAO.Database
   Set XLDB = OpenDatabase( _
   CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;")
   '-- OPEN XLS SHEET AS REMOTE RS
   Dim XLRS As DAO.Recordset
   Dim RCROW()
   Dim RC As Long
   Dim I As Integer
   Dim TD As DAO.TableDef
   '-- LOOP THROUGH XLDB TABLES (SHEETS)
   For Each TD In XLDB.TableDefs
   '-----------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (C) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
      '--------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (I) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
   Next
SUB_CLOSE:
   '-- COLOSE XLDB AND XLRS
   Set XLRS = Nothing
'   XLDB.Close
   Set XLDB = Nothing
   '------------------------'
   '-- CLOSE DB AND DBRS
   Set DBRS = Nothing
   XLDB.Close
   Set XLDB = Nothing
End Sub
وهذه هي المفرفقات التى تتضمن المثال...

CS_SeetNumberLabels2.xlsx 85.5 kB · 3 تنزيلات Posters.accdb 568 kB · 3 تنزيلات

**أبو إبراهيم الغامدي** · مايو 8, 2020

أهلا بك @ابو البشر

1 ساعه مضت, ابو البشر said:

- ما المقصود في الاؤقام المسجلة في 1 و 2

2- ما المقصود ب F1 و هل يمكن تغيير النطاق في 4 وكيف يتم ذلك لو اغترضنا أن ملف الاكسل نريد جلب بيانات اكثر من عامود في الصفحة الواحدة دون تكرار للكود كما فعلنا في الكود السابق بمعنى بجلب بيانات العمود C والعمود I مباشرة أو حتى أكثر من عمودين ؟؟؟؟

بارك الله فيكم وفي علمكم ...

بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها..

المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0

يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2). وكمثال (0,0)RCROW يعيد قيمة العمود الأول من الصف الأول في جدول البيانات.

بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس..

إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة...

بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد..

أرجو أن يكون هذا التفسير واضحاً ومفهوماً ..

**عفرنس** · مايو 8, 2020

2 دقائق مضت, أبو إبراهيم الغامدي said:

أهلا بك @ابو البشر

بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها..

المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0

يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2). وكمثال (0,0)RCROW يعيد قيمة العمود الأول من الصف الأول في جدول البيانات.

بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس..

إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة...

بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد..

أرجو أن يكون هذا التفسير واضحاً ومفهوماً ..

ما شاء الله عليك .. كفيت ووفيت . .

**ابو البشر** · مايو 8, 2020

بارك الله فيك أستاذي عبدالعزيز @أبو إبراهيم الغامدي وكتب الله أجرك وأثابك ...... تقبل الله منا ومنكم صالح الاعمال .....

الان اصبحت العملية مفهومه ..... شكرا لك ولجميع أعضاء المنتدى المبارك :signthankspin: :fff:

**Barna** · مايو 9, 2020

ماشاء الله تبارك الله أخي @أبو إبراهيم الغامدي وكل عام وانت بخير

تسجيل الدخول

استفسار حول كود استيراد بيانات من ملف اكسل

الردود الموصى بها

ابو البشر

أبو إبراهيم الغامدي

عفرنس

ابو البشر

Barna

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information