هل نستطيع جلب حقل او اثنين من الاكسال الى اكسيس

[أبو امين]

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

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

مثال :

لي جدول على الاكسال يحتوي على : 

1/ الاسم و اللقب 

2/ تاريخ الولادة 

3/ الجنس 

4/ اسم الاب 

و جدول على الاكسيس يحتوي 

1/ الاسم و اللقب 

2/ تاريخ الولادة 

3/ الجنس 

4/ اسم الاب 

5/ القسم 

6/ المنحة 

7/ الحالة 

 

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

1/ الاسم و اللقب 

2/ تاريخ الولادة 

3/ الجنس 

4/ اسم الاب 

حيث ياخذ حقل :

( الاسم و اللقب) من جدول الاكسال مكان حقل (الاسم و اللقب) بجدول الاكسيس 

( تاريخ الولادة) من جدول الاكسال مكان حقل (تاريخ الولادة) بجدول الاكسيس 

( الجنس ) من جدول الاكسال مكان حقل (الجنس ) بجدول الاكسيس 

و هكذا دواليك 

 

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

[أبو امين]

اهلين و سهلين استاذ 

• د.كاف يار

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

[د.كاف يار]

ارفق مثال لكي يتم التعديل عليه

او اتبع الطريقة التالية

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

 

ثانيا / الصف الكودي التالي في اي مكان داخل المحرر

Public Function importExcel(Tablename As String, FilePath 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 = FilePath

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

Set xlWb = xlApp.Workbooks.Open(varfile)
Set xlWs = xlWb.Worksheets(1)
    intLine = 2            'سيتم استيراد الصفوف بدء من الصف رقم 2

Do
    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) 'رقم 1 يعني العمود رقم 1 في ملف الاكسل
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) 'رقم 2 يعني العمود رقم 2 في ملف الاكسل
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) 'رقم 3 يعني العمود رقم 3 في ملف الاكسل
    
    strSqlDml = "INSERT INTO [" & Tablename & "] 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
End Function

و في ازرار استيراد البيانات الصق الكود التالي

Dim Addfile As Object: Set Addfile = Application.FileDialog(3)
With Addfile: .Filters.Add "All Files", "*.xlsx"
    If .Show = True Then
        ' Call importExcel("Table Name", "File Path")
        Call importExcel("tb1", Trim(.SelectedItems(1)))
	End if
End With

 

 

[أبو امين]

يا اللله بارك الله فيك : سواء استطعت التطبيق ام لا المهم اشكرك جزيل الشكر على سرعة الرد و ان شاء الله في ميزان حسناتك .

سانكب على تطبيق الاكواد و اوافيك بالنتيجة يا غالي 

[أبو امين]

استاذي الكريم طبقت الكود مثلما ذكر لكن اولا 

1/ المكتبة التي ذكرتها لم اجدها و انما وجدت المكتبة التالية المبينة بالصورة 

2/ عندما اردت استيراد الحقول ظهر هذا الخطا 

 

مع العلم انني مثبت الاكساس 2010 على حاسوبي بنظام 32 بايت 

و اشتغل على اكسيس 2007 

شكرا 

تم تعديل مايو 27, 2022 بواسطه derbali ammar
اضافة

[د.كاف يار]

6 دقائق مضت, derbali ammar said:

1/ المكتبة التي ذكرتها لم اجدها و انما وجدت المكتبة التالية المبينة بالصورة 

 

ممتاز ثبتها و جرب الكود

 

6 دقائق مضت, derbali ammar said:

2/ عندما اردت استيراد الحقول ظهر هذا الخطا 

 

استبدل الكود بالتالي

Public Function importExcel(Tablename As String, FilePath 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

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

Set xlWb = xlApp.Workbooks.Open(FilePath)
Set xlWs = xlWb.Worksheets(1)
    intLine = 2            'سيتم استيراد الصفوف بدء من الصف رقم 2

Do
    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) 'رقم 1 يعني العمود رقم 1 في ملف الاكسل
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) 'رقم 2 يعني العمود رقم 2 في ملف الاكسل
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) 'رقم 3 يعني العمود رقم 3 في ملف الاكسل
    
    strSqlDml = "INSERT INTO [" & Tablename & "] 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
End Function

 

[أبو امين]

ما شاء الله عليك يا دكتور و الله مبدع : شكرا جزيلا على المساعدة جعلها الله في ميزان حسناتك 

ذعوة خير تونسية : "  الله يستر حالك و يعطيك الخير "

[د.كاف يار]

3 دقائق مضت, derbali ammar said:

ذعوة خير تونسية : "  الله يستر حالك و يعطيك الخير "

العفو اخي الكريم و تحت امرك و الأمر كله لله 

[أبو امين]

استاذي الكريم : نجحت العملية و استطعت الدخول للاستيراد لكن تخرج رسالة مثل ما هو مبين بالصورة 

 

 

مع العلم ان الجدول الذي اردت تصديره يوجد به 4 حقول فقط و هم : 

1/ الاسم و اللقب 

2/ تاريخ الولادة 

3/ الجنس 

4/ اسم الاب 

في حين الجدول الموجود بالاكساس يوجد به العديد من الحقول 

هل ان المشكلة تتمثل في ضرورة وجود نفس الحقول في الاكسيس و الاكسال ام هناك مشكلة اخرى 

 

 

تم تعديل مايو 27, 2022 بواسطه derbali ammar

[أبو عبدالله الحلوانى]

مشاركة معي استاذنا @د.كاف يار جزاه الله خيرا

استخدم هذا الكود فقط بدون مكتبات

TablName= MyAccessTbleName  'ضع بدل هذا المتغير اسم الجدول الموجود بالأكسس
ExlFilPath= MyExelFileFullName  'ضع بدل هذا المتغير مسار ملف الاكسل بالكامل مثل: D:\Exel1.xlsx
"A1:F2000"  ' هذا المدي الموجود به البيانات بشيت الاكسل غيره حسب ما هو موجود عندك
Docmd.TransferSpreadsheet(acImport,acSpreadsheetTypeExcel12,TablName,ExlFilPath,true,"A1:F2000")

هذا والله أعلم

[د.كاف يار]

تفضل هذا التعديل لتجاوز الخطأ

Public Function importExcel(Tablename As String, FilePath As String)
On Error Resume Next
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

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

Set xlWb = xlApp.Workbooks.Open(FilePath)
Set xlWs = xlWb.Worksheets(1)
    intLine = 2            'سيتم استيراد الصفوف بدء من الصف رقم 2

Do
    strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) 'رقم 1 يعني العمود رقم 1 في ملف الاكسل
    strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) 'رقم 2 يعني العمود رقم 2 في ملف الاكسل
    strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) 'رقم 3 يعني العمود رقم 3 في ملف الاكسل
    
    strSqlDml = "INSERT INTO [" & Tablename & "] 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
End Function