الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

طلب لتعديل كود

مغلق
بدأه Need_To_Know في 20 يوليو 2007 · 1 رد · 373 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

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

اخوان

اريد منكم طلب بسيط باذن الله عزوجل

انا بروجكت ينقل قيمه من ملف اكسيل الى ملف اكسيس

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

اريد منكم :

1 : هذا البروجكت يتقل الجهاز كتير اذا ممكن حل هذه المشكله

2 : اريد ان اجعل البرنامج يا خذ القيمه الموجوده فى الخليه المشار اليها و اضافتها الى ملف الاكسيس اى ان يبقى على القيم

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

هذا هو الكود :

Public cn As New ADODB.Connection

Public rs As New ADODB.Recordset

Public excelBook As Excel.Workbook

Public xlSheet As Excel.Worksheet

Public fileNameExcel As Variant

Private Sub Command1_Click()

fileNameExcel = ""

CommonDialog1.CancelError = True

CommonDialog1.Filter = "Excel files: ( *.xls ) |*.xls|"

CommonDialog1.ShowOpen

If CommonDialog1.FileName = "" Then Exit Sub

If Dir(CommonDialog1.FileName) = "" Then Exit Sub

fileNameExcel = CommonDialog1.FileName

If LCase(Right(fileNameExcel, 4)) <> ".xls" Then Exit Sub

If fileNameExcel <> "" Then Call excelToAccess

ErrHandler:

Exit Sub

End Sub

Public Sub excelToAccess()

Dim firstRow, currentRow, currentCell As Variant

Set xlSheet = Nothing

Set excelBook = Nothing

Set excelBook = Application.Workbooks.Open(fileNameExcel)

Set xlSheet = Worksheets(1)

firstRow = 2

currentRow = firstRow

currentCell = xlSheet.Cells(currentRow, 1).Value

While currentCell <> ""

Set rs = cn.Execute("SELECT * FROM TableName WHERE id=" & xlSheet.Cells(currentRow, 1).Value & "")

If rs.EOF Then

cn.Execute "insert into TableName(id) values(" & xlSheet.Cells(currentRow, 1).Value & ") "

Else

cn.Execute "update TableName set id=" & xlSheet.Cells(currentRow, 1).Value

End If

currentCell = xlSheet.Cells(currentRow, 1).Value

Wend

excelBook.Close

Set rs = Nothing

Set xlSheet = Nothing

End Sub

Private Sub Form_Load()

Set cn = New ADODB.Connection

cn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & App.Path & "\databaseName.mdb;"

End Sub

و المشروع فى المرفقات

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

Excel_to_access.rar

#2

أكواد فعلاً قيمة وكنت أبحث عنها.

مشكور ألف

هذا الموضوع مغلق.

مواضيع مشابهة