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

[النهر العطشان]

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

في المرفق قاعدة بيانات تعمل على استيراد بيانات من ملف اكسل خارجي 

طريقة عملها هو عند الضغط على زر (تحديد المسار) تقوم بفتح نافذه واستيراد البيانات فورا

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

1- زر (تحديد المسار)  يقوم بتحديد مسار الملف في الكمبيوتر فقط 

2- اضافة زر جديد (استيراد بيانات) يقوم بعملية نقل البيانات من ملف الاكسل الخارجي المحدد بالزر الاول .

يرجى استخدام نفس الكود في التعديل وشكرا

Access-Import.accdb

[husamwahab]

تفضل التعديل ارجو ان يكون طلبك

Access-Import-1.rar

[النهر العطشان]

شكرا استاذنا الفاضل husamwahab جعلها الله في ميزان حسناتك 

وهو المطلوب

 

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

[husamwahab]

بالخدمة استاذ ورحم الله والديك

تفضل التعديل الخاص بعدد السجلات التي سيتم نقلها

ملاحظة : الكود منقول للامانة مع بعض التعديلات و يرجى التاكد من فاعليته

Access-Import-2.rar

[النهر العطشان]

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

شكرا استاذنا الفاضل husamwahab جعلها الله في ميزان حسناتك

وهو المطلوب

[husamwahab]

بالخدمة استاذ

[محمد التميمي]

في ٢٣‏/٨‏/٢٠٢١ at 22:48, husamwahab said:

بالخدمة استاذ ورحم الله والديك

تفضل التعديل الخاص بعدد السجلات التي سيتم نقلها

ملاحظة : الكود منقول للامانة مع بعض التعديلات و يرجى التاكد من فاعليته

Access-Import-2.rar 25.57 kB · 16 downloads

السلام عليكم استاذ حسام

تم التاكد من فعالية الكود وهو يعمل بامتياز 

ولاكن قمت بتعديل على الجدول للتاكد من فعالية العمل مع الترقيم التلقائي وقد نجح التعديل

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

واجريت عملية الاستيرا للبيانات عدة مرات ونجح الامر وكلما اجريت عملية استيراد لسجلات جديدة يقوم الترقيم التلقائي بالعمل حسب الاصول

سؤالي : هل هذه الطريقة فعالة وخالية من المشاكل مستقبلا اذا ازداد عدد السجلات وبلغ الالف

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

[husamwahab]

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

23 ساعات مضت, محمد التميمي said:

تم التاكد من فعالية الكود وهو يعمل بامتياز

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

23 ساعات مضت, محمد التميمي said:

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

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

لذا السؤال يحال الى اصحاب الخبرة اساتذتنا الاجلاء جزاهم الله كل خير 

وعذرا للتقصير 

[محمد التميمي]

انشاء الله يتفاعل الاخوة معنا شكرا استاذ حسام

[hassansaat]

السلام عليكم ارجو حل هذه المشكلة عند الضغط على زر الاستيراد تظهر هذة الرسالة

يمكن أن يحدث هذا الخطأ عند فشل تشغيل حدث لأنه تعذر تقييم موقع منطق هذا الحدث. على سبيل المثال، في حالة تعيين الخاصية 'عند_الفتح' لأحد النماذج إلى =[حقل]، يحدث هذا الخطأ إذ من المتوقع أن يتم تشغيل اسم حدث أو ماكرو عند بدء الحدث.

Access-Import.accdb

[د.كاف يار]

@hassansaat

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

في البداية قم بإستدعاء مكتبة الإكسل 

 

الآن نقوم بإنشاء Module جديد و اضافة الكود التالي

Public filenname As String
Public Function importExcel(tablename As String) As String ', filenname As String

Dim xlApp                   As Excel.Application
Dim xlWb                    As Excel.Workbook
Dim xlWs                    As Excel.Worksheet
Dim intLine                 As Long
Dim strSqlDml               As String
Dim strColumn1 As String, strColumn2 As String, strColumn3 As String

    varfile = filenname
    CurrentDb.Execute "DELETE * FROM List", dbFailOnError

Set xlApp = New Excel.Application
    xlApp.Visible = False

Set xlWb = xlApp.Workbooks.Open(varfile)
Set xlWs = xlWb.Worksheets(1)
    intLine = 2

Do
    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value)
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value)
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value)
    
    strSqlDml = "INSERT INTO List VALUES('" & strColumn1 & "', '" & strColumn2 & "', '" & strColumn3 & "')"
    CurrentDb.Execute strSqlDml, dbFailOnError
    xlWs.Cells(intLine, 1).Select
    intLine = intLine + 1
Loop Until IsEmpty(xlWs.Cells(intLine, 1))

    xlWb.Close False
    xlApp.Quit

Set xlApp = Nothing
Set xlWb = Nothing
Set xlWs = Nothing
filenname = ""
End Function
Public Sub SelectFiles()

Dim Addfile As Object
Set Addfile = Application.FileDialog(3)
With Addfile
  .AllowMultiSelect = False
  .InitialFileName = ""
  .Filters.Clear
  .Filters.Add "Excel Files", "*.xls,*.xlsx"
  If .Show = True Then
      filenname = Trim(.SelectedItems(1))
      Else
      Exit Sub
  End If
End With
End Sub

 

شرح مختصر للكود نقوم بالإعلان عن متغييرات تحمل اسماء مستعارة للأعمدة في ملف الإكسل  مثلا  strColumn1 -strColumn2 - strColumn3 

Dim strColumn1 As String, strColumn2 As String, strColumn3 As String

الأن نقوم بتعريف المتغييرات على الأعمدة في ملف الأكسل

من خلال التعريف xlWs.Cells(intLine, 1).Value 

حيث أن رقم 1 هو العمود رقم 1 في الاكسل و هكذا

    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value)
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value)
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value)

 

تفضل التعديل

Access-Import.accdb

[محمد التميمي]

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

@hassansaat

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

في البداية قم بإستدعاء مكتبة الإكسل 

 

الآن نقوم بإنشاء Module جديد و اضافة الكود التالي

Public filenname As String
Public Function importExcel(tablename As String) As String ', filenname As String

Dim xlApp                   As Excel.Application
Dim xlWb                    As Excel.Workbook
Dim xlWs                    As Excel.Worksheet
Dim intLine                 As Long
Dim strSqlDml               As String
Dim strColumn1 As String, strColumn2 As String, strColumn3 As String

    varfile = filenname
    CurrentDb.Execute "DELETE * FROM List", dbFailOnError

Set xlApp = New Excel.Application
    xlApp.Visible = False

Set xlWb = xlApp.Workbooks.Open(varfile)
Set xlWs = xlWb.Worksheets(1)
    intLine = 2

Do
    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value)
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value)
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value)
    
    strSqlDml = "INSERT INTO List VALUES('" & strColumn1 & "', '" & strColumn2 & "', '" & strColumn3 & "')"
    CurrentDb.Execute strSqlDml, dbFailOnError
    xlWs.Cells(intLine, 1).Select
    intLine = intLine + 1
Loop Until IsEmpty(xlWs.Cells(intLine, 1))

    xlWb.Close False
    xlApp.Quit

Set xlApp = Nothing
Set xlWb = Nothing
Set xlWs = Nothing
filenname = ""
End Function
Public Sub SelectFiles()

Dim Addfile As Object
Set Addfile = Application.FileDialog(3)
With Addfile
  .AllowMultiSelect = False
  .InitialFileName = ""
  .Filters.Clear
  .Filters.Add "Excel Files", "*.xls,*.xlsx"
  If .Show = True Then
      filenname = Trim(.SelectedItems(1))
      Else
      Exit Sub
  End If
End With
End Sub

 

شرح مختصر للكود نقوم بالإعلان عن متغييرات تحمل اسماء مستعارة للأعمدة في ملف الإكسل  مثلا  strColumn1 -strColumn2 - strColumn3 

Dim strColumn1 As String, strColumn2 As String, strColumn3 As String

الأن نقوم بتعريف المتغييرات على الأعمدة في ملف الأكسل

من خلال التعريف xlWs.Cells(intLine, 1).Value 

حيث أن رقم 1 هو العمود رقم 1 في الاكسل و هكذا

    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value)
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value)
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value)

 

السلام عليكم

بارك الله بجهودك القيمة استاذي الكريم  د.كاف يار

الشكر كل الشكر لك بالمرور والمشاركة

هل لي ان اعرف كيف السبيل الى استيراد بيانات من اكسل الى اكسس بوجود الترقيم التلقائي في جدول الاكسس وبطريقة صحيحة وامنة للبيانات

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

 

تم تعديل سبتمبر 19, 2021 بواسطه محمد التميمي

[د.كاف يار]

8 ساعات مضت, محمد التميمي said:

السلام عليكم

بارك الله بجهودك القيمة استاذي الكريم  د.كاف يار

الشكر كل الشكر لك بالمرور والمشاركة

هل لي ان اعرف كيف السبيل الى استيراد بيانات من اكسل الى اكسس بوجود الترقيم التلقائي في جدول الاكسس وبطريقة صحيحة وامنة للبيانات

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

 

ارفق رابط المشاركة المعنية