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

[abouelhassan]

السلام عليكم ورحمة الله اخوانى الافاضل

لدى فورم اسمه frm_Itemsيحتوى على كل البيانات من خلال البحث وجدت بالمنتدى كودين ممتازين احدهم للتصدير للاكسيل والثانى الاستيراد من اكسيل الى الاكسيس

Private Sub Command137_Click()
   On Error Resume Next
   
Dim ImpEX As String
Dim strSQL As String
   
 
   ' حذف محتويات الجدول
                                strSQL = "DELETE tbl1.* FROM tbl_Items;"
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL strSQL
                                DoCmd.SetWarnings True
                                
 'استيراد جدول الاكسيل الى الاكسيس
        
        
              ImpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX"
   
     
               DoCmd.TransferSpreadsheet acImport, 8, "tbl_Items", ImpEX, True
              
      MsgBox "تم استيراد البيانات من الاكسيل بنجاح"

End Sub

Private Sub Command138_Click()
   On Error Resume Next
   
  Dim ExpEX As String
  
   ExpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX"
   
MsgBox "تم تصدير البيانات الى الاكسيل بنجاح"
     
 '    DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, ExpEX, True

' فى حالة عدم الرغبة فى اظهار الملف
DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, ExpEX, False
End Sub

استخدمتهم وهم يعملان تمام بس احتاج لتعديل وهو تحديد مكان حفظ الملف والملف المستورد الى الاكسيس عند الضغط على زر استعراض

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

الان عند الضغط على زر استيراد يستورد البيانات من الملف بجانب القاعدة ويصدر البيانات الى ملف بجوار القاعدة اريد تعديل بحيث اختار مكان ملف الاكسيل من استعراض 

بارك الله فيكم جميعا يارب

 

DATA10041.mdb

[محمد أبوعبدالله]

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

ضع الكود التالي في زر استعراض

With Application.FileDialog(3)
        .Title = "Choose File"
        .Filters.Clear
          .Filters.Clear
          .Filters.Add "Excel 2007-2013", "*.xlsx"
          .Filters.Add "Excel 2003", "*.xls"
        .AllowMultiSelect = False
        .InitialFileName = ""
     If .Show = -1 Then
       Me.FilePath.Value = .SelectedItems(1)
    End If
End With

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

ImpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX"

بالتالي

ImpEX = Me.FilePath.Value

DATA10041.mdb

تحياتي

ايضا تفضل هذا الموضوع اخي الكريم ستجد به فوائد كثيرة ان شاء الله

تحياتي

[abouelhassan]

بارك الله فيك استاذى الحبيب محمد أبوعبدالله ورزقك كل خير الدنيا والاخرة اللهم امين

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

نموذج تحديد مكان حفظ الملف 

زادك الله من فضله اللهم امين يارب

[abouelhassan]

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

و ذلك عند الضغط على استيراد او تصدير الى الاكسيل يطلب منا تحديد المسار لكى يتم تنفيذ كود التصدير او الاستيراد

بارك الله فيك اخى

احترامى وتقديرى

[محمد أبوعبدالله]

السلام عليكم

عند الاستيراد اضفط زر استعراض اولاً ثم خدد الملف واضغط زر استيراد

وعند التصدير استخدم الكود التالي

        On Error GoTo err:
        DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, , False
        MsgBox "أكسس صدر البيانات المطلوبة إلى ملف إكسل بنجاح"
err:
        MsgBox "مشكلة بتصدير الملف"

DATA10041.mdb

تحياتي

[أ / محمد صالح]

بعد إذن أخي محمد ابو عبد الله

وإذا كنت تريد التصدير لنفس الملف يمكنك استبدال هذا السطر في كود التصدير 

ExpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX"

بالتالي

  ExpEX = Me.FilePath.Value

طبعا بشرط أن يتم تحديد الملف بزر استعراض اولا

والا يكون اسم الملف فارغا

بالتوفيق

[abouelhassan]

ربنا يكرمك استاذى الحبيب محمد أبوعبدالله حفظك الله ورعاك وبارك فيك

بارك الله فيك اخى الكريم استاذ أ / محمد صالح زادك الله من فضله

استاذى اردت عمل اضافة للكود فى حالة ان المسار فارغ وضغطت استورد يخرج رسالة يجب تحديد مسار الملف اولا ووضعت الشرط والرسالة فى اول الكود بس للاسف لم يعمل

كمان اريد تغير اسم الملف الاكسيل بدل tbl_Items.XLSX الى اسم قاعدة البيانات

ربنا يكرمك استاذى الغالى بارك الله فيك

   On Error Resume Next
   
Dim ImpEX As String
Dim strSQL As String
   
 
   ' ÍÐÝ ãÍÊæíÇÊ ÇáÌÏæá
                                strSQL = "DELETE tbl1.* FROM tbl_Items;"
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL strSQL
                                DoCmd.SetWarnings True
                                
 '
                If FilePath = "" Then
                MsgBox " يجب تحديد مسار الملف اولا", vbCritical + vbMsgBoxRight, "تنبيه"
End If
              ImpEX = Me.FilePath.Value
'              ImpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX"
   
     
               DoCmd.TransferSpreadsheet acImport, 8, "tbl_Items", ImpEX, True
              
      MsgBox "اكسس استورد البيانات المطلوبة من ملف اكسيل بنجاح"

 

[أ / محمد صالح]

حتى يعمل ينبغي وضع قبل end if

Call FileDialog_Click
exit sub

للخروج من الاجراء وفتح مستعرض الملفات

وبالنسبة لموضوع اسم الملف 

فالذي يحدده المستعرض

ربما لم يصلني ما تريد بدقة

[abouelhassan]

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

Private Sub estrad_Click()
   On Error Resume Next
   
Dim ImpEX As String
Dim strSQL As String
   
 
   ' ÍÐÝ ãÍÊæíÇÊ ÇáÌÏæá
                                strSQL = "DELETE tbl1.* FROM tbl_Items;"
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL strSQL
                                DoCmd.SetWarnings True
                                
 ' ÇÓÊíÑÇÏ ÌÏæá ÇáÅßÓá Åáì ÌÏæá ÇáÃßÓÓ ÇáãØáæÈ
                If Me.FilePath = "" Then
                MsgBox "íÌÈ ÊÍÏíÏ ãÓÇÑ ÇáãáÝ ÇæáÇð", vbCritical + vbMsgBoxRight, "ÊäÈíå"
Call FileDialog_Click
Exit Sub
End If
              ImpEX = Me.FilePath.Value
'              ImpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX"
   
     
               DoCmd.TransferSpreadsheet acImport, 8, "tbl_Items", ImpEX, True
              
      MsgBox "ÃßÓÓ ÇÓÊæÑÏ ÇáÈíÇäÇÊ ÇáãØáæÈÉ  ãä ãáÝ ÅßÓá ÈäÌÇÍ"

End Sub

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

شكر وتقدير من القلب

[أ / محمد صالح]

مفيش مشكلة 

خلينا في المهمة الأساسية

ضع قبل end if

exit sub

للخروج من الاجراء

وبعدها يتم الضغط على استعراض منفصلا

[abouelhassan]

مشكور استاذى أ / محمد صالح

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

الان عن الضغط على استيراد حتى دون تحديد المسار لملف الاكسيل يتم استيراد البيانات وعند التصدير كل مرة تخرج لى رسالة حدث مشكلة فى التصدير

كمان الان لا يوجد دور لمسار الملف الذى باعلى الزرين استيراد وتصدير اسم الملف الاكسيل اريده باسم قاعدة البيانات الان اسمه tbl_Items.xlsx

بارك الله فيك اخى الكريم

DATA10041.mdb

تم تعديل أغسطس 5, 2021 بواسطه abouelhassan

[أ / محمد صالح]

ظهور رسالة الخطأ في كل مرة يتم التصدير حلها وضع exit sub

قبل err

Exit Sub
err:

دور مربع المسار أنه يتم فيه نسخ مسار الملف الذي يتم اختياره للاستيراد

واسم الملف الذي يتم تصديره يمكن تعديله في نافذة تحديد مكان التصدير

[abouelhassan]

مشكور استاذى أ / محمد صالح بارك الله فيك اخى

ما احتاجه ان اضغط استعراض واحدد مكان ملف الاكسيل اضغط استيراد يستورد

البيانات وعند الضغط على استيراد وكان المسار فارغ تخرج رسالة يجب تحديد مسار ملف الاكسيل

انا حاولت اعملته 

الان بعد ما كتبت هذه الجملة بالكود

Call FileDialog_Click

الضغط على استيراد يفتح جدول تحديد المسار هذا غير مطلوب اخى

كمان بعد ظهور الدول واختيار cancel

 

اجد الاتى تم استيراد بيانات فارغة 

كمان الرسالة ظهرت عند التصدير

التعديلات المطلوبة على الكود

الاستيراد

عند الضغط على زر استيراد تظهر رسالة يجب تحديد مسار الملف

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

التصدير

عند النجاح فى تصدير الملف لا تظهر رسالة مشكلة بالتصدير

شاكر فضلك استاذ محمد

ربنا يرضى عنك اخى

بارك الله فيك اخى الكريم

 

تم تعديل أغسطس 5, 2021 بواسطه abouelhassan

[أ / محمد صالح]

حسب فهمي للصورة النهائية للمطلوب

تفضل هذه أكواد استيراد واستعراض وتصدير 

Private Sub estrad_Click()
If IsNull(Me.FilePath.Value) Then
MsgBox "يجب تحديد مسار الملف اولاً", vbCritical + vbMsgBoxRight, "تنبيه"
Else
Dim ImpEX As String
Dim strSQL As String
' حذف محتويات الجدول
strSQL = "DELETE tbl1.* FROM tbl_Items;"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
' استيراد جدول الإكسل إلى جدول الأكسس المطلوب
ImpEX = Me.FilePath.Value
DoCmd.TransferSpreadsheet acImport, 8, "tbl_Items", ImpEX, True
Me.Requery
MsgBox "أكسس استورد البيانات المطلوبة  من ملف إكسل بنجاح"
End If
End Sub

Private Sub FileDialog_Click()
With Application.FileDialog(3)
.Title = "اختر ملفا لاستيراده"
.Filters.Clear
.Filters.Add "Excel 2007", "*.xlsx"
.Filters.Add "Excel 2003", "*.xls"
.AllowMultiSelect = False
.InitialFileName = ""
If .Show = True Then
Me.FilePath.Value = .SelectedItems(1)
Else
MsgBox "تم إلغاء الإجراء."
End If
End With
End Sub

Private Sub tasder_Click()
On Error GoTo err:
DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, , False
MsgBox "أكسس صدر البيانات المطلوبة إلى ملف إكسل بنجاح"
Exit Sub
err:
MsgBox "مشكلة بتصدير الملف"
End Sub

بالتوفيق 

[abouelhassan]

بارك الله فيك استاذ أ / محمد صالح زادك الله علما اخى وبارك لك اللهم امين

كود التصدير تمام وكود الاستعراض ايضا تمام

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

احترامى وتقديرى وخالص الدعاء من اخيك

تم تعديل أغسطس 6, 2021 بواسطه abouelhassan

[أ / محمد صالح]

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

If Me.FilePath = "" Then

ولكن طالما ظهر هذا الخطأ

جرب دالة isnull 

If IsNull(Me.FilePath.Value) Then

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

بالتوفيق 

[abouelhassan]

اشكرك استاذى أ / محمد صالح بارك الله فيك وظادك من فضله اللهم امين 

احترامى لك اخى