زر استيراد من الأكسل الى الأكسس

ArabMan · ديسمبر 13, 2023

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

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

في الاكسيس (اي اضافة في الجدول فقط)

على سبيل المثال عندي جدول في الاكسيس باسم MyTable ويحتوي على ثلاث اعمدة

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

تم تعديل ديسمبر 13, 2023 بواسطه ArabMan

**Foksh** · ديسمبر 13, 2023

11 دقائق مضت, ArabMan said:

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

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

في الاكسيس (اي اضافة في الجدول فقط)

تفضل أخي الكريم ,,

ضع هذا الكود في حدث عند النقر

وأعطيني النتيجة

Dim dlg As FileDialog
    Dim fileName As String
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    dlg.Filters.Add "ملفات Excel", "*.xls; *.xlsx"
    If dlg.Show = -1 Then
        fileName = dlg.SelectedItems(1)
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "YourQueryOrTableName", fileName, True
        MsgBox "تم تصدير البيانات بنجاح إلى: " & fileName, vbInformation
    Else
        MsgBox "تم الغاء اختيار الملف.", vbExclamation
    End If

* استبدل YourQueryOrTableName باسم جدولك

ArabMan · ديسمبر 13, 2023

1 hour ago, Foksh said:

تفضل أخي الكريم ,,

ضع هذا الكود في حدث عند النقر

وأعطيني النتيجة

Dim dlg As FileDialog
    Dim fileName As String
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    dlg.Filters.Add "ملفات Excel", "*.xls; *.xlsx"
    If dlg.Show = -1 Then
        fileName = dlg.SelectedItems(1)
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "YourQueryOrTableName", fileName, True
        MsgBox "تم تصدير البيانات بنجاح إلى: " & fileName, vbInformation
    Else
        MsgBox "تم الغاء اختيار الملف.", vbExclamation
    End If

* استبدل YourQueryOrTableName باسم جدولك

شكرآً جزيلاً على التفاعل السريع

تظهر رسالة خطاء بعد اضافة الكود على الزر

ارجو الاطلاع

image.png.513e4589a650a5a1d0f580ff132588a3.png

**kkhalifa1960** · ديسمبر 13, 2023

تفضل أخي مرفق من أعمال استاذي ومعلمي @ابو جودي فيه طلبك . :fff:

Access Import_ up 2.rar

**Foksh** · ديسمبر 13, 2023

4 دقائق مضت, ArabMan said:

شكرآً جزيلاً على التفاعل السريع

تظهر رسالة خطاء بعد اضافة الكود على الزر

ارجو الاطلاع

Access Export.accdb

ArabMan · ديسمبر 13, 2023

53 minutes ago, kkhalifa1960 said:

تفضل أخي مرفق من أعمال استاذي ومعلمي @ابو جودي فيه طلبك .

Access Import_ up 2.rar 27.62 kB · 5 downloads

توجد مشكلة بنفس المشكلة السابقة image.png.581f9bc1eb0795e04910295b3709c2f5.png

53 minutes ago, Foksh said:

Access Export.accdb 344 kB · 5 downloads

تمت التجربة

تظهر انه تمت عملية التوريد بنجاح لكن عند الرجوع الى الجدول لا يوجد شيئ

**kkhalifa1960** · ديسمبر 13, 2023

أخي أكيد في مشكلة عندك أنا أعمل على ويندوس 10 و32 بت و أفيس 10 بروفيشنال ، طالع الصورة . :fff:

162.gif.5be205cfcac036618a3aaf39ff4ed024.gif

تم تعديل ديسمبر 13, 2023 بواسطه kkhalifa1960

**Foksh** · ديسمبر 13, 2023

18 دقائق مضت, ArabMan said:

تظهر انه تمت عملية التوريد بنجاح لكن عند الرجوع الى الجدول لا يوجد شيئ

اخي الكريم تأكد انه ما عندك مشكلة بالأوفيس ، لإنه تمت تجربته على آكسيس ٢٠١٦ ويعمل بكفاءة ،

اخي انت تريد تصدير من آكسيس الى إكسيل ، صح ؟ 🥴

**ابو جودي** · ديسمبر 13, 2023

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

اليكم الخطوات
1- انشاء وحدة نمطية عامة ليسهل استخدامها فى شتى زوايا التطبيق واعطها الاسم التالى basFileUtilityKit وضع بها هذا الكود


' Enumeration for the types of file dialogs
Enum EnumFileDialogType
    msoFileDialogFilePicker = 1
    msoFileDialogFolderPicker = 4
End Enum

' Enumeration for different file extensions
Enum EnumFileExtensions
    AllFiles
    TextFiles
    ExcelFiles
    ImageFiles
    VideoFiles
    AudioFiles
    PDFFiles
    WordFiles
    ' You can add additional file extensions as needed here
End Enum

' Enumeration for different options related to file paths
Enum EnumOptionFile
    DirectoryWithoutFileName
    DirectoryWithFileName
    FileNameWithExtension
    FileNameWithoutExtension
    ExtensionOnly
End Enum

' Function to open the folder dialog and return the selected folder path
Function GetFolderDialog() As String
    On Error Resume Next
    Dim folderDialogObject As Object
    Set folderDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFolderPicker)
    
    With folderDialogObject
        .Title = "Select Folder"
        .AllowMultiSelect = False
        .Show
    End With
    
    If folderDialogObject.SelectedItems.Count > 0 Then
        GetFolderDialog = folderDialogObject.SelectedItems(1)
    Else
        ' Handle the case where no folder is selected
        MsgBox "No folder selected.", vbExclamation
        GetFolderDialog = ""
    End If
    
    Set folderDialogObject = Nothing
    On Error GoTo 0
End Function

' Function to open the file dialog and return the selected file path
Function GetFileDialog(ByVal EnumFileExtension As EnumFileExtensions) As String
    On Error Resume Next
    
    
    ' Check if the Microsoft Office Object Library is referenced
    ' Make sure to go to Tools > References and select the appropriate version
    ' e.g., "Microsoft Office 16.0 Object Library" for Office 2016

Dim fileDialogObject As Object
    Set fileDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFilePicker)
    
    With fileDialogObject
        .Title = "Select File"
        .AllowMultiSelect = False
        .Filters.Clear
        ' Adding filters based on the selected file extension
        Select Case EnumFileExtension
            Case EnumFileExtensions.AllFiles
                .Filters.Add "All Files", "*.*"
            Case EnumFileExtensions.TextFiles
                .Filters.Add "Text Files", "*.txt"
            Case EnumFileExtensions.ExcelFiles
                .Filters.Add "Excel Files", "*.xlsx; *.xls"
            Case EnumFileExtensions.ImageFiles
                .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.gif"
            Case EnumFileExtensions.VideoFiles
                .Filters.Add "Video Files", "*.mp4; *.avi; *.mov"
            Case EnumFileExtensions.AudioFiles
                .Filters.Add "Audio Files", "*.mp3; *.wav; *.ogg"
            Case EnumFileExtensions.PDFFiles
                .Filters.Add "PDF Files", "*.pdf"
            Case EnumFileExtensions.WordFiles
                .Filters.Add "Word Files", "*.docx; *.doc"
            ' You can add additional file extensions as needed here
        End Select
        
        .Show
    End With
    
    If fileDialogObject.SelectedItems.Count > 0 Then
        GetFileDialog = fileDialogObject.SelectedItems(1)
    Else
        ' Handle the case where no file is selected
        MsgBox "No file selected.", vbExclamation
        GetFileDialog = ""
    End If
    
    Set fileDialogObject = Nothing
    
    Exit Function
    
    If Err.Number <> 0 Then
    
    Select Case Err.Number
        Case 3078: Resume Next  ' Ignore error if user cancels the file dialog
        Case 0: Resume Next
        Case Else
'             Call ErrorLog(Err.Number, Error$, strProcessName)
    End Select
        ' Clear the error
        Err.Clear
    End If

End Function

' Function to get the desired option for a file path
Function GetFileOption(ByRef strFilePath As String, Optional ByRef EnumOptionFile As EnumOptionFile = DirectoryWithFileName) As String
    On Error Resume Next
    Select Case EnumOptionFile
        Case DirectoryWithoutFileName
            GetFileOption = Left(strFilePath, InStrRev(strFilePath, "\"))
        
        Case DirectoryWithFileName
            GetFileOption = strFilePath
        
        Case FileNameWithExtension
            GetFileOption = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)
        
        Case ExtensionOnly
            GetFileOption = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "."))
        
        Case FileNameWithoutExtension
            GetFileOption = Mid(strFilePath, InStrRev(strFilePath, "\") + 1, InStrRev(strFilePath, ".") - InStrRev(strFilePath, "\") - 1)
    End Select
    On Error GoTo 0
End Function

' Function to get additional information about a file
Function GetFileInfo(filePath As String) As String
    On Error Resume Next
    Dim fileInfo As String
    fileInfo = "File Information:" & vbCrLf
    fileInfo = fileInfo & "Path: " & filePath & vbCrLf
    fileInfo = fileInfo & "Size: " & FileLen(filePath) & " bytes" & vbCrLf
    fileInfo = fileInfo & "Created: " & FileDateTime(filePath) & vbCrLf
    GetFileInfo = fileInfo
    On Error GoTo 0
End Function

2- انشاء وحدة نمطية عامة ليسهل استخدامها فى شتى زوايا التطبيق واعطها الاسم التالى basExcelDataImport وضع بها هذا الكود

Public Const strTableExcel As String = "tblImportExcel"

Function ExcelDataImport(ByRef excelFilePath As String)
    On Error Resume Next ' Disable error handling temporarily
    
    Const xlOpenXMLWorkbook As Long = 51

    ' Variables for Excel and Access
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelOpened As Boolean
    Dim sourceFileName As String
    Dim mainDirectory As String
    Dim convertedExcelFilePath As String

    ' Check if the Excel file path is provided
    If Nz(excelFilePath, "") = "" Then Exit Function


    ' Check if the Excel file exists
    If Dir(excelFilePath) = "" Then Exit Function

    ' Extract file information
    sourceFileName = GetFileOption(excelFilePath, FileNameWithExtension)
    mainDirectory = GetFileOption(excelFilePath, DirectoryWithoutFileName)
    convertedExcelFilePath = excelFilePath

    ' Create Excel application object
    Set excelApp = CreateObject("Excel.Application")

    ' Check if Excel application is successfully created
    If Err.Number <> 0 Then
        Err.Clear
        Set excelApp = CreateObject("Excel.Application")
        excelOpened = False
    Else
        excelOpened = True
    End If

    ' Reset error handling
    On Error GoTo 0

    ' Set Excel application visibility
    excelApp.Visible = False

    ' Open Excel workbook
    Set excelWorkbook = excelApp.Workbooks.Open(mainDirectory & sourceFileName)

    ' Save the workbook in xlsx format without displaying alerts
    excelApp.DisplayAlerts = False
    excelWorkbook.SaveAs Replace(mainDirectory & sourceFileName, ".xls", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    excelApp.DisplayAlerts = True

    ' Close the workbook without saving changes
    excelWorkbook.Close False

    ' Quit Excel application if it was opened by the function
    If excelOpened = True Then excelApp.Quit

    ' Update the source file name with the new extension
    sourceFileName = sourceFileName & "x"

    ' Reset file attributes
    SetAttr mainDirectory & sourceFileName, vbNormal

    ' Import Excel data into Access table
    DoCmd.SetWarnings False
       
    'acSpreadsheetTypeExcel8
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strTableExcel, mainDirectory & sourceFileName, True
    

ExitFunction:
    ' Enable system alerts before exiting the function
    DoCmd.SetWarnings True
    Exit Function

ErrorHandler:
    ' Handle errors
    Select Case Err.Number
        Case 3078: Resume Next  ' Ignore error if user cancels the file dialog
        Case 0: Resume Next
        Case Else
'             Call ErrorLog(Err.Number, Error$, strProcessName)
    End Select
End Function


' Function to delete all records from the specified table
Sub DeleteAllRecords(Optional ByRef strTable As String = "")
    On Error Resume Next
    
    If Nz(strTable, "") = "" Then strTable = strTableExcel
       
    CurrentDb.Execute "DELETE FROM " & strTable

    
     ' Handle errors
    Select Case Err.Number
        Case 3078
            If strTable = strTableExcel Then Resume Next Else
                     
        Case Else
'             HandleAndLogError strProcessName
    End Select
End Sub

3- انشاء نموذج وفى الحدث عند النقر على زر الامر استخدم الكود التالى

Private Sub cmdSubmit_Click()
    ' Get the path of the Excel file
    Dim strFilePath As String
    strFilePath = GetFileDialog(EnumFileExtensions.ExcelFiles)

    ' Check if a file was selected
    If strFilePath <> "Cancelled" Then
        ' Show status label
        Me!lblStatus.Visible = True
        Me!lblStatus.Caption = "Please wait ... "

        ' Clear TableData
        DeleteAllRecords

        ' Import data from Excel
        ExcelDataImport strFilePath
        
        
        ' Add Or Update Yor Table
        
        ' Hide the status label or reset any visual indicator
        Me!lblStatus.Visible = False
    Else
         
        ' User canceled the file selection
        MsgBox "File selection canceled", vbExclamation

    End If
End Sub

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

واخيرا مرفق قاعدة البيانات

ImportFromExel.accdb

**Foksh** · ديسمبر 13, 2023

@ابو جودي الحمد لله على السلامة ، وعودة طيبة بعد الغياب الطويل ، وأسأل الله ان تكون في تمام الصحة والعافية .

تم تعديل ديسمبر 13, 2023 بواسطه Foksh

ArabMan · ديسمبر 13, 2023

1 hour ago, Foksh said:

اخي الكريم تأكد انه ما عندك مشكلة بالأوفيس ، لإنه تمت تجربته على آكسيس ٢٠١٦ ويعمل بكفاءة ،

اخي انت تريد تصدير من آكسيس الى إكسيل ، صح ؟ 🥴

لا من اكسيل الى اكسيس و في جدول معين كا اضافة داخل جدول بنفس الصفوف و الاعمدة

و شكراً لك

**Foksh** · ديسمبر 13, 2023

36 دقائق مضت, ArabMan said:

لا من اكسيل الى اكسيس و في جدول معين كا اضافة داخل جدول بنفس الصفوف و الاعمدة

و شكراً لك

يعني استيراد من ملف اكسيل إلى جدول في آكسيس ، 😅

ArabMan · ديسمبر 13, 2023

1 hour ago, ابو جودي said:

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

اليكم الخطوات
1- انشاء وحدة نمطية عامة ليسهل استخدامها فى شتى زوايا التطبيق واعطها الاسم التالى basFileUtilityKit وضع بها هذا الكود


' Enumeration for the types of file dialogs
Enum EnumFileDialogType
    msoFileDialogFilePicker = 1
    msoFileDialogFolderPicker = 4
End Enum

' Enumeration for different file extensions
Enum EnumFileExtensions
    AllFiles
    TextFiles
    ExcelFiles
    ImageFiles
    VideoFiles
    AudioFiles
    PDFFiles
    WordFiles
    ' You can add additional file extensions as needed here
End Enum

' Enumeration for different options related to file paths
Enum EnumOptionFile
    DirectoryWithoutFileName
    DirectoryWithFileName
    FileNameWithExtension
    FileNameWithoutExtension
    ExtensionOnly
End Enum

' Function to open the folder dialog and return the selected folder path
Function GetFolderDialog() As String
    On Error Resume Next
    Dim folderDialogObject As Object
    Set folderDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFolderPicker)
    
    With folderDialogObject
        .Title = "Select Folder"
        .AllowMultiSelect = False
        .Show
    End With
    
    If folderDialogObject.SelectedItems.Count > 0 Then
        GetFolderDialog = folderDialogObject.SelectedItems(1)
    Else
        ' Handle the case where no folder is selected
        MsgBox "No folder selected.", vbExclamation
        GetFolderDialog = ""
    End If
    
    Set folderDialogObject = Nothing
    On Error GoTo 0
End Function

' Function to open the file dialog and return the selected file path
Function GetFileDialog(ByVal EnumFileExtension As EnumFileExtensions) As String
    On Error Resume Next
    
    
    ' Check if the Microsoft Office Object Library is referenced
    ' Make sure to go to Tools > References and select the appropriate version
    ' e.g., "Microsoft Office 16.0 Object Library" for Office 2016

Dim fileDialogObject As Object
    Set fileDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFilePicker)
    
    With fileDialogObject
        .Title = "Select File"
        .AllowMultiSelect = False
        .Filters.Clear
        ' Adding filters based on the selected file extension
        Select Case EnumFileExtension
            Case EnumFileExtensions.AllFiles
                .Filters.Add "All Files", "*.*"
            Case EnumFileExtensions.TextFiles
                .Filters.Add "Text Files", "*.txt"
            Case EnumFileExtensions.ExcelFiles
                .Filters.Add "Excel Files", "*.xlsx; *.xls"
            Case EnumFileExtensions.ImageFiles
                .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.gif"
            Case EnumFileExtensions.VideoFiles
                .Filters.Add "Video Files", "*.mp4; *.avi; *.mov"
            Case EnumFileExtensions.AudioFiles
                .Filters.Add "Audio Files", "*.mp3; *.wav; *.ogg"
            Case EnumFileExtensions.PDFFiles
                .Filters.Add "PDF Files", "*.pdf"
            Case EnumFileExtensions.WordFiles
                .Filters.Add "Word Files", "*.docx; *.doc"
            ' You can add additional file extensions as needed here
        End Select
        
        .Show
    End With
    
    If fileDialogObject.SelectedItems.Count > 0 Then
        GetFileDialog = fileDialogObject.SelectedItems(1)
    Else
        ' Handle the case where no file is selected
        MsgBox "No file selected.", vbExclamation
        GetFileDialog = ""
    End If
    
    Set fileDialogObject = Nothing
    
    Exit Function
    
    If Err.Number <> 0 Then
    
    Select Case Err.Number
        Case 3078: Resume Next  ' Ignore error if user cancels the file dialog
        Case 0: Resume Next
        Case Else
'             Call ErrorLog(Err.Number, Error$, strProcessName)
    End Select
        ' Clear the error
        Err.Clear
    End If

End Function

' Function to get the desired option for a file path
Function GetFileOption(ByRef strFilePath As String, Optional ByRef EnumOptionFile As EnumOptionFile = DirectoryWithFileName) As String
    On Error Resume Next
    Select Case EnumOptionFile
        Case DirectoryWithoutFileName
            GetFileOption = Left(strFilePath, InStrRev(strFilePath, "\"))
        
        Case DirectoryWithFileName
            GetFileOption = strFilePath
        
        Case FileNameWithExtension
            GetFileOption = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)
        
        Case ExtensionOnly
            GetFileOption = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "."))
        
        Case FileNameWithoutExtension
            GetFileOption = Mid(strFilePath, InStrRev(strFilePath, "\") + 1, InStrRev(strFilePath, ".") - InStrRev(strFilePath, "\") - 1)
    End Select
    On Error GoTo 0
End Function

' Function to get additional information about a file
Function GetFileInfo(filePath As String) As String
    On Error Resume Next
    Dim fileInfo As String
    fileInfo = "File Information:" & vbCrLf
    fileInfo = fileInfo & "Path: " & filePath & vbCrLf
    fileInfo = fileInfo & "Size: " & FileLen(filePath) & " bytes" & vbCrLf
    fileInfo = fileInfo & "Created: " & FileDateTime(filePath) & vbCrLf
    GetFileInfo = fileInfo
    On Error GoTo 0
End Function

2- انشاء وحدة نمطية عامة ليسهل استخدامها فى شتى زوايا التطبيق واعطها الاسم التالى basExcelDataImport وضع بها هذا الكود

Public Const strTableExcel As String = "tblImportExcel"

Function ExcelDataImport(ByRef excelFilePath As String)
    On Error Resume Next ' Disable error handling temporarily
    
    Const xlOpenXMLWorkbook As Long = 51

    ' Variables for Excel and Access
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelOpened As Boolean
    Dim sourceFileName As String
    Dim mainDirectory As String
    Dim convertedExcelFilePath As String

    ' Check if the Excel file path is provided
    If Nz(excelFilePath, "") = "" Then Exit Function


    ' Check if the Excel file exists
    If Dir(excelFilePath) = "" Then Exit Function

    ' Extract file information
    sourceFileName = GetFileOption(excelFilePath, FileNameWithExtension)
    mainDirectory = GetFileOption(excelFilePath, DirectoryWithoutFileName)
    convertedExcelFilePath = excelFilePath

    ' Create Excel application object
    Set excelApp = CreateObject("Excel.Application")

    ' Check if Excel application is successfully created
    If Err.Number <> 0 Then
        Err.Clear
        Set excelApp = CreateObject("Excel.Application")
        excelOpened = False
    Else
        excelOpened = True
    End If

    ' Reset error handling
    On Error GoTo 0

    ' Set Excel application visibility
    excelApp.Visible = False

    ' Open Excel workbook
    Set excelWorkbook = excelApp.Workbooks.Open(mainDirectory & sourceFileName)

    ' Save the workbook in xlsx format without displaying alerts
    excelApp.DisplayAlerts = False
    excelWorkbook.SaveAs Replace(mainDirectory & sourceFileName, ".xls", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    excelApp.DisplayAlerts = True

    ' Close the workbook without saving changes
    excelWorkbook.Close False

    ' Quit Excel application if it was opened by the function
    If excelOpened = True Then excelApp.Quit

    ' Update the source file name with the new extension
    sourceFileName = sourceFileName & "x"

    ' Reset file attributes
    SetAttr mainDirectory & sourceFileName, vbNormal

    ' Import Excel data into Access table
    DoCmd.SetWarnings False
       
    'acSpreadsheetTypeExcel8
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strTableExcel, mainDirectory & sourceFileName, True
    

ExitFunction:
    ' Enable system alerts before exiting the function
    DoCmd.SetWarnings True
    Exit Function

ErrorHandler:
    ' Handle errors
    Select Case Err.Number
        Case 3078: Resume Next  ' Ignore error if user cancels the file dialog
        Case 0: Resume Next
        Case Else
'             Call ErrorLog(Err.Number, Error$, strProcessName)
    End Select
End Function


' Function to delete all records from the specified table
Sub DeleteAllRecords(Optional ByRef strTable As String = "")
    On Error Resume Next
    
    If Nz(strTable, "") = "" Then strTable = strTableExcel
       
    CurrentDb.Execute "DELETE FROM " & strTable

    
     ' Handle errors
    Select Case Err.Number
        Case 3078
            If strTable = strTableExcel Then Resume Next Else
                     
        Case Else
'             HandleAndLogError strProcessName
    End Select
End Sub

3- انشاء نموذج وفى الحدث عند النقر على زر الامر استخدم الكود التالى

Private Sub cmdSubmit_Click()
    ' Get the path of the Excel file
    Dim strFilePath As String
    strFilePath = GetFileDialog(EnumFileExtensions.ExcelFiles)

    ' Check if a file was selected
    If strFilePath <> "Cancelled" Then
        ' Show status label
        Me!lblStatus.Visible = True
        Me!lblStatus.Caption = "Please wait ... "

        ' Clear TableData
        DeleteAllRecords

        ' Import data from Excel
        ExcelDataImport strFilePath
        
        
        ' Add Or Update Yor Table
        
        ' Hide the status label or reset any visual indicator
        Me!lblStatus.Visible = False
    Else
         
        ' User canceled the file selection
        MsgBox "File selection canceled", vbExclamation

    End If
End Sub

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

واخيرا مرفق قاعدة البيانات

ImportFromExel.accdb 452 kB · 1 download

شكرا جزيلاً على جهودك عزيزي

لكن سؤال، هل فقط استيراد ام استيراد واضافة الى جدولً ما؟

**ابو جودي** · ديسمبر 13, 2023

5 دقائق مضت, ArabMan said:

لكن سؤال، هل فقط استيراد ام استيراد واضافة الى جدولً ما؟

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

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

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

**Foksh** · ديسمبر 13, 2023

ما اتضح لي من سياق الطلب ، هو تصدير من اكسيس الى إكسيل ، على العموم بالنسبة لهذه النقطة:

3 ساعات مضت, ArabMan said:

تظهر انه تمت عملية التوريد بنجاح لكن عند الرجوع الى الجدول لا يوجد شيئ

ستجد في ملف الآكسيل حتى لو كان فارغاً وليس به اي بيانات ، ستجد ورقة جديدة باسم الجدول في الآكسيس وفيها ستجد البيانات التي تم تصديرها ، إلا إنك تريد العكس وهو الإستيراد 😊

تم تعديل ديسمبر 13, 2023 بواسطه Foksh

تسجيل الدخول

زر استيراد من الأكسل الى الأكسس

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

ArabMan

Foksh

ArabMan

kkhalifa1960

Foksh

ArabMan

kkhalifa1960

Foksh

ابو جودي

Foksh

ArabMan

Foksh

ArabMan

ابو جودي

Foksh

Join the conversation

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

تصفح الموقع

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

Support

Important Information