خطا در ایجاد کاربرگ جدید در اکسل توسط اکسس

[moustafa]

با سلام
توسط کدهای زیر از طریق اکسس یک فایل مشخص روبا اکسس باز می کنیم و می خوایم یک کاربرگ جدید ایجاد کنیم که اطلاعات کاربرگی که پروتکت شده است بریزیم توش برای ویرایش و امیپورت به اکسس

156190
که بعضا با خطای زیر مواجهه میشم و بعضا با زدن end و اجرا کردن مجدد کد دیگه خطا نمیده و عملیات اجرا میشه
156191
به این کد هم اصلاح کردم بازم مشکل پابرجاست

wrk.Sheets.Add After:=ActiveSheet

[mazoolagh]

سلام و روز خوش

بنظر میاد فایل مدتی زمان میبره تا کامل خونده بشه،
یا در دسترس بشه (جای دیگه lock شده ؟؟).
شاید هم مشکل شبکه (فایل روی اینترنت ؟؟) یا درایو کند هست.

[moustafa]

سلام و روز خوش

بنظر میاد فایل مدتی زمان میبره تا کامل خونده بشه،
یا در دسترس بشه (جای دیگه lock شده ؟؟).
شاید هم مشکل شبکه (فایل روی اینترنت ؟؟) یا درایو کند هست.
عرض ادب استاد وسرور گرامی. اون وقت چرا برای بار دوم که بلافاصله کد باتن مربوطه رو میزنم بدون خطا اجرا میشه ؟ رو لپ تاپ خونگیم که 16 گیگ رم و هاراد 552 اس اس دی داره بطور اف لاین هم این مشکل پیش میاد ! تازه کدهای بعدیش که چندین فانکشن بررسی و تحلیل و محاسبات و رکوردست مقایسه ای هستش به سرعت اجرا میشه .
vba مثل پایتون تابع sleep برای وقفه دادن نداره ؟
با سپاس و تشکر فراوان از اینهمه خوبی

[moustafa]

در ادامه این خطا پیش میاد بنظر اشیا Set نمیشن !!
156192
156193

[mazoolagh]

مشخصا اون worksheet به اسم info رو پیدا نمیکنه.

اینجوری دیباگ کنین:
بعد از set شدن xlapp یک break-point بذارین و در immediate اینها رو اجرا کنین
? xlapp.worksheets.count
? xlapp.worksheets(1).name

[moustafa]

مشخصا اون worksheet به اسم info رو پیدا نمیکنه.

اینجوری دیباگ کنین:
بعد از set شدن xlapp یک break-point بذارین و در immediate اینها رو اجرا کنین
? xlapp.worksheets.count
? xlapp.worksheets(1).name
نحوه کار اینطوره که ما میخوایم از یک فایل اکسل اطلاعات یک کاربرگی که اسمش فارسی ،عنوان ستونهاش فارسی و پروتکت شده است داخل اکسس ایمپورت و به جدول مربوطه الحاق کنیم .بخاطر پروتکت بودن(به لحاظ امنیتی دسترسی به پس ورو نخواهیم داشت) ناچارا یه کاربرگ جدید به اسم انگلیسی info ایجاد کنیم و اطلاعات رو از اون کاربرگ پروتکت شده کپی کنیم به اون وسپس عناوین ستونها رو مطابق نام جدولی که در اکسس داریم به انگلیسی تغییر بدیم و ایمپورت کنیم داخل اکسسس و اطلاعاتش رو به جدول اصلی مون الحاق کنیم . خطاهای ذکر شده موردی پیش میاد حتی بدون دیباگ و زدن دکمه end برای بار بعدی بدون خطا اجرا میشه . به ذهنم رسید که در کنترل خطا به لیبلی پاس بدم که فایل اکسل باز شده رو بدون ذخیره ببنده و مجددا کدها رو از اول اجرا کنه که جواب نداد یعنی حتما باید به اون پیام ارور جواب end رو بدی و برای بار بعد بدون خطا اجرا بشه
فایل رو ضمیمه کردم بی زحمت یه بررسی فرمائید frmAppend فرم مورد نظر وفایل اکسل که اول به فارسی بود به انگلیسی تغیر دادم در کنار برنامه اکسس
با سپاس وتشکر فراوان

[eb_1345]

نحوه کار اینطوره که ما میخوایم از یک فایل اکسل اطلاعات یک کاربرگی که اسمش فارسی ،عنوان ستونهاش فارسی و پروتکت شده است داخل اکسس ایمپورت و به جدول مربوطه الحاق کنیم .بخاطر پروتکت بودن(به لحاظ امنیتی دسترسی به پس ورو نخواهیم داشت) ناچارا یه کاربرگ جدید به اسم انگلیسی info ایجاد کنیم و اطلاعات رو از اون کاربرگ پروتکت شده کپی کنیم به اون وسپس عناوین ستونها رو مطابق نام جدولی که در اکسس داریم به انگلیسی تغییر بدیم و ایمپورت کنیم داخل اکسسس و اطلاعاتش رو به جدول اصلی مون الحاق کنیم . خطاهای ذکر شده موردی پیش میاد حتی بدون دیباگ و زدن دکمه end برای بار بعدی بدون خطا اجرا میشه . به ذهنم رسید که در کنترل خطا به لیبلی پاس بدم که فایل اکسل باز شده رو بدون ذخیره ببنده و مجددا کدها رو از اول اجرا کنه که جواب نداد یعنی حتما باید به اون پیام ارور جواب end رو بدی و برای بار بعد بدون خطا اجرا بشه
فایل رو ضمیمه کردم بی زحمت یه بررسی فرمائید frmAppend فرم مورد نظر وفایل اکسل که اول به فارسی بود به انگلیسی تغیر دادم در کنار برنامه اکسس
با سپاس وتشکر فراوان

سلام
وقت بخیر
برای انتقال اطلاعات شیت مورد نظر فایل اکسل به جدول مربوطه در فایل اکسس از کدهای زیادی استفاده کرده ای در صورتیکه میشه با تعداد کدهای به مراتب کمتر عملیات انتقال اطلاعات رو مستقیما از همون کاربرگی که دارای عنوان وستون های فارسی میباشه به جدول اصلی فایل اکسس انجام داد.

[moustafa]

سلام
وقت بخیر
برای انتقال اطلاعات شیت مورد نظر فایل اکسل به جدول مربوطه در فایل اکسس از کدهای زیادی استفاده کرده ای در صورتیکه میشه با تعداد کدهای به مراتب کمتر عملیات انتقال اطلاعات رو مستقیما از همون کاربرگی که دارای عنوان وستون های فارسی میباشه به جدول اصلی فایل اکسس انجام داد.

سلام ودرود جناب بهرامی عزیز

چنانچه زحمتی نباشه مشتاق یادگیری روش شما استاد وسرور گرامی رو همون فایل می باشم .
با سپاس و تشکر فراوان

[eb_1345]

در هر صورت چنانچه زحمتی نباشه مشتاق یادگیری روش شما استاد وسرور گرامی رو همون فایل می باشم .

ابتدا یک روال برای انتقال اطلاعات( شیت اطلاعات) به داخل فایل اکسس ایجاد می کنیم:


Private Sub ImportExcelData()
On Error Resume Next
Dim sFilePathName As String
Const sPassword As String = "125"
Dim xlApp As New Excel.Application
Dim xlWb As New Excel.Workbook
CurrentDb.Execute "Drop Table tblExcel"
With xlApp
.Visible = False
Set xlWb = .Workbooks.Open(txtFileName, , , , sPassword)
'.Sheets(1).Select
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "tblExcel", txtFileName, True
xlWb.Close
.Quit
End With
CurrentDb.TableDefs("tblExcel").Fields(0).Name = "f1"
DoCmd.RunSQL "DELETE * FROM tblExcel WHERE (f4 =""فصل"")"


در این روال فرض شده که فایل اکسل دارای پسورده و پسورد اون هم 125 هستش
بر اساس دستور ایمپورت در روال فوق اطلاعات فایل اکسل در جدولی با نام tblExcel در داخل فایل اکسس اضافه میشه
وقتی اطلاعات در جدول فوق درج میشه عناوین ستون های جدول اکسل در رکورد اول اضافه میشه که باید حذف بشه
با توجه به اینکه در جدول فوق عنوان فیلد ها(غیر از فیلد اول) با حرف F و اندیس 2 شروع میشه عنوان فیلد اول رو به F1 تغییر نام میدهیم

اگه روال فوق رو بدون درنظر گرفتن دو خط آخر امتحان کنی موارد ذکر شده در جدول فوق مشاهده میشه
پس با کد ماقبل آخر عنوان فیلد اول رو بهF1 تبدیل می کنیم و با کد آخر هم رکورد اول رو از جدول حذف می کنیم

حالا میریم سراغ اضافه نمودن رکوردهای جدول فوق به جدول اصلی فایل اکسس که من در این مثال نام tblMain برای این جدول بکار برده ام
پس برای این منظور تابعی بصورت زیر ایجاد می کنیم:


Public Sub AppendData(MainTable As String, ExcelTable As String)
'On Error Resume Next
Dim Fld1 As DAO.Field, Fld2 As DAO.Field, StrSql As String, FldName As String, Fld1Select As String
Dim RS1 As DAO.Recordset
Call ImportExcelData
Set RS1 = CurrentDb.OpenRecordset(MainTable)
Dim RS2 As DAO.Recordset
Set RS2 = CurrentDb.OpenRecordset(ExcelTable)
For Each Fld1 In RS1.Fields
FldName = FldName & ", " & Fld1.Name
Next
For Each Fld2 In RS2.Fields
Fld1Select = Fld1Select & "," & ExcelTable & "." & Fld2.Name
Next
FldName = Right(FldName, Len(FldName) - 1)
Fld1Select = Right(Fld1Select, Len(Fld1Select) - 1)
DoCmd.SetWarnings False
StrSql = "INSERT INTO " & MainTable & " (" & FldName & ")SELECT " & Fld1Select & " FROM " & ExcelTable & ""
DoCmd.RunSQL StrSql
DoCmd.SetWarnings True
MsgBox ("پايان عمليات انتقال اطلاعات")
RS1.Close
RS2.Close
Set RS1 = Nothing
Set RS2 = Nothing
End Sub


در نهایت اگه فرض بر این باشه که در هر دفعه انتقال اطلاعات جدول اصلی باید خالی بشه از کد زیر برای انتقال اطلاعات استفاده می کنیم:


If Nz(Me.txtFileName, "") = "" Then
MsgBox ("لطفا يک فايل انتخاب کنيد")
Exit Sub
End If
DoCmd.RunSQL "DELETE * FROM tblMain"
Call AppendData("tblMain", "tblExcel")

[eb_1345]

راستش من نمونه رو از جوانب مختلف امتحان نکردم . لذا چنانچه اگه مشکلی داشت که حتماً داره یا مواردی که مد نظرتونه که باید در کدهای مربوطه لحاظ بشه اطلاع بده تا نمونه رو اصلاح کنم

[eb_1345]

.................................................. ...........

[eb_1345]

ضمناً من در نمونه در جدول tblMain فیلد ID رو حذف کرده ام. اگر قراره این فیلد در جدول فوق وجود داشته باشه و برای اینکه این فیلد در لیست فیلدهائی که در متغییر FldName درج میشه قرار نگیره بجای عدد 1 در کد FldName = Right(FldName, Len(FldName) - 1)
عدد 5 جایگزین کن !

[moustafa]

بسیار سپاسگذارم جناب بهرامی از اینهمه لطف و زحمت . بررسی ونتیجه رو عرض میکنم

[eb_1345]

ضمناً بخاطر اینکه در نمونه فوق بجای نام جدول tblEtelate_peymankari از نام tblMain استفاده کرده بودم نمونه رو مجدداً با همان نام tblEtelate_peymankari اصلاح کردم

[moustafa]

1- ما به پس ورد هرگز دسترسی نخواهیم داشت اون سایتی که اطلاعات رو ازش دانلود می کنیم این امکان رو نداده بخاطر اینکه اطلاعات دستکاری نشه ضمنا خود فایل پس ورد نداره کاربرگ یا شیت 1 پس ورد داره
2- به نام فیلد ها به انگلیسی برای ساخت جستجو ،کوئری ،گزارش و فرم نیاز داریم که متحضرید با نام فارسی نمیشه کد نویسی کرد

[eb_1345]

1- ما به پس ورد هرگز دسترسی نخواهیم داشت اون سایتی که اطلاعات رو ازش دانلود می کنیم این امکان رو نداده بخاطر اینکه اطلاعات دستکاری نشه ضمنا خود فایل پس ورد نداره کاربرگ یا شیت 1 پس ورد داره

ظاهراً در شیت 1 فقط عنوان ستون ها درج شده و اطلاعات اصلی شما در شیت اطلاعات درج شده . اطلاعات این شیت بدون در نظر گرفتن پسورد هم قابل انتقال به جدول اکسس می باشه.
پس در نتیجه مشکلی از این بابت نباید وجود داشته باشه

[eb_1345]

2- به نام فیلد ها به انگلیسی برای ساخت جستجو ،کوئری ،گزارش و فرم نیاز داریم که متحضرید با نام فارسی نمیشه کد نویسی کرد

شما برای انجام مواردی فوق نیاز به جدول tblEtelate_peymankari خواهید داشت که نام فیلدهای جدول فوق هم لاتین میباشه .
جدول tblExcel هم صرفاً یک جدول موقت و واسطه که اطلاعات کاربرگ فایل اکسل رو به جدول tblEtelate_peymankari اضافه می کنه

[moustafa]

3- اطلاعات چندین شرکت وارد میشه و بعضا بروز رسانی میشه بنابراین باید از ورود اطلاعات تکراری جلوگیری بشه

[eb_1345]

3- اطلاعات چندین شرکت وارد میشه و بعضا بروز رسانی میشه بنابراین باید از ورود اطلاعات تکراری جلوگیری بشه
برای جلوگیری از ورود اطلاعات تکراری کد زیر به آخر کدهای روال ImportExcelData اضافه شد.


DoCmd.RunSQL "DELETE * FROM tblExcel WHERE tblExcel.code_rojo IN (SELECT V.code_rojo FROM tblExcel AS V INNER JOIN tblEtelate_peymankari AS N ON V.code_rojo = N.code_rojo);"

با استفاده از کد فوق دو جدول tblEtelate_peymankari و tblExcel در فیلد code_rojo با هم مقایسه میشن و اگر مقدار این فیلد در هر دو جدول با هم برابر بود اطلاعات مشترک در جدول tblExcel حذف میشه و اگه اطلاعاتی هم در اون وجود داشته باشه اطلاعات جدیدتریست که قبلا به جدول اصلی اکس اضافه نشده که در انتقال جدید باید به جدول tblEtelate_peymankari اضافه بشه
کدهای تابع AppendData هم بصورت زیر تغییر می کنه :


Private Sub btnAppend_ClickPublic Sub AppendData(MainTable As String, ExcelTable As String)
'On Error Resume Next
Dim Fld1 As DAO.Field, Fld2 As DAO.Field, StrSql As String, FldName As String, Fld1Select As String
Dim RS1 As DAO.Recordset
Dim RS2 As DAO.Recordset
Call ImportExcelData
Set RS1 = CurrentDb.OpenRecordset(MainTable)
Set RS2 = CurrentDb.OpenRecordset(ExcelTable)
For Each Fld1 In RS1.Fields
FldName = FldName & ", " & Fld1.Name
Next
For Each Fld2 In RS2.Fields
Fld1Select = Fld1Select & "," & ExcelTable & "." & Fld2.Name
Next
FldName = Right(FldName, Len(FldName) - 5)
Fld1Select = Right(Fld1Select, Len(Fld1Select) - 1)

DoCmd.SetWarnings False
StrSql = "INSERT INTO " & MainTable & " (" & FldName & ")SELECT " & Fld1Select & " FROM " & ExcelTable & ""
DoCmd.RunSQL StrSql
DoCmd.SetWarnings True
If DCount("*", "tblEtelate_peymankari", "") > 0 And DCount("*", "tblExcel", "") = 0 Then
MsgBox " ÇØáÇÚÇÊ ÌÏíÏí ÈÑÇí ÇÖÇÝå ÔÏä æÌæÏ äÏÇÑÏ "
Else
MsgBox ("ÇíÇä ÚãáíÇÊ ÇäÊÞÇá ÇØáÇÚÇÊ")
End If
RS1.Close
RS2.Close
Set RS1 = Nothing
Set RS2 = Nothing
End Sub

[moustafa]

جناب بهرامی تا قبل پست 19 مرحله به مرحله تریس کردم بسیار عالی و دلچسب و سریع وبدون خطا ....لذت بردم دستتون درد نکنه
و در جهت تکمیل شدن بحث:
5-فرمت فیلدهای مبالغ در قالب متنی و با کاما هستش در حالیکه به نوع عددی و بدون کاما نیاز دارم که جداکننده اش در خود اکسس تنظیم شده باشه و همینطور فیلدهای تاریخ هم از نوع متنی و شامل ممیز هستش که می خوایم اونم از نوع عددی و بدون ممیز وارد بشه و در خود اکسس با ماسک ممیز گذاشته بشه
با تشکر

[eb_1345]

3- اطلاعات چندین شرکت وارد میشه و بعضا بروز رسانی میشه بنابراین باید از ورود اطلاعات تکراری جلوگیری بشه


برای جلوگیری از ورود اطلاعات تکراری کد زیر به آخر کدهای روال ImportExcelData اضافه شد.


DoCmd.RunSQL "DELETE * FROM tblExcel WHERE tblExcel.code_rojo IN (SELECT V.code_rojo FROM tblExcel AS V INNER JOIN tblEtelate_peymankari AS N ON V.code_rojo = N.code_rojo);"

با استفاده از کد فوق دو جدول tblEtelate_peymankari و tblExcel در فیلد code_rojo با هم مقایسه میشن و اگر مقدار این فیلد در هر دو جدول با هم برابر بود اطلاعات مشترک در جدول tblExcel حذف میشه و اگه اطلاعاتی هم در اون وجود داشته باشه اطلاعات جدیدتریست که قبلا به جدول اصلی اکس اضافه نشده که در انتقال جدید باید به جدول tblEtelate_peymankari اضافه بشه

در ارتباط با کد بالا که در واقع برای چک کردن اطلاعات تکراری از اون استفاده میشه این نکته رو باید اضافه کنم که اگه فیلد code_rojo رو بعنوان فیلد یکتا در بین فیلدهای جدول اکسل در نظر بگیریم با استفاده از این کد صرفا از ورود اطلاعات تکراری جلوگیری میشه ولی اگه در جدول اکسل بدون اضافه شدن رکورد جدید تغییراتی در اطلاعات قبلی سایر فیلدها(ستون ها ) صورت گرفته باشه در این حالت کد بالا دیگه جوابگو نخواهد بود.
لذا از اونجائی که تعداد ستونهای جدول فایل اکسل زیاده و امکان مقایسه فیلدهای متناظر در دو جدول در این حالت کار سختیه بنظر من برای رفع این مشکل با استفاده از کد بالا بجای اینکه اطلاعات تکراری رو از جدول اکسل حذف کنیم بیائیم کلیه اطلاعاتی که قبلا در جدول اصلی اکسس وارد شده و با اطلاعات جدول اکسل در فیلد code_rojo مشترک میباشه حذف و مجددا کلیه اطلاعات جدول اکسل رو به جدول اصلی اکسس اضافه کنیم .در این حالت آخرین اطلاعات جدید و بروز رسانی شده به جدول اصلی اکسس اضافه میشه.
در حالت جدید کد زیر باید جایگزین کد قبلی بشه:


DoCmd.RunSQL "DELETE * FROM tblEtelate_peymankari WHERE tblEtelate_peymankari.code_rojo IN (SELECT V.code_rojo FROM tblEtelate_peymankari AS V INNER JOIN tblExcel AS N ON V.code_rojo = N.code_rojo);"

[eb_1345]

نمونه جدیدتر با اعمال کد جایگزین شده پست قبل
در پوشه این نمونه یک فایل اکسل با نام Book1.xlsx وجود دارد که اطلاعات شیت اون قابل ویرایشه. برای امتحان اطلاعات این فایل رو تغییر بده و اون رو به فایل اکسس اضافه کن و نتیجه انتقال رو در جدول اصلی اکسس بررسی کن !

[eb_1345]

جناب بهرامی تا قبل پست 19 مرحله به مرحله تریس کردم بسیار عالی و دلچسب و سریع وبدون خطا ....لذت بردم دستتون درد نکنه

خواهش میکنم
پیشنهاد میکنم با توجه به توضیحاتی که در پست 21 داده ام از نمونه پست 22 استفاده کنی



و در جهت تکمیل شدن بحث:
5-فرمت فیلدهای مبالغ در قالب متنی و با کاما هستش در حالیکه به نوع عددی و بدون کاما نیاز دارم که جداکننده اش در خود اکسس تنظیم شده باشه و همینطور فیلدهای تاریخ هم از نوع متنی و شامل ممیز هستش که می خوایم اونم از نوع عددی و بدون ممیز وارد بشه و در خود اکسس با ماسک ممیز گذاشته بشه

در خصوص تغییر فرمت فیلدهای عددی و تاریخ هم با توجه به اینکه جدول tblEtelate_peymankari بر خلاف جدول tblExcel که در خلال انتقال اطلاعات ایجاد میشه ثابته و خصوصیات فیلدهای اون هم ثابته میتوانی ابتدا فرمت فیلدهای جدول فوق رو مطابق خواسته خودت تغییر بدی و برای حذف علامت کاما از فیلدهای عددی و اسلش از فیلدهای تاریخ میتوانی از کدهای روال زیر استفاده کنی:


Public Sub ConvertField()
On Error Resume Next
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Set rs = CurrentDb.OpenRecordset("tblEtelate_peymankari")
Do While Not rs.EOF
rs.Edit
For Each fld In rs.Fields
If Not IsNull(fld) Then
If fld.Name Like "*mablagh*" Then
fld = Replace(fld, ",", "")
ElseIf fld.Name Like "*tarikh*" Then
fld = Replace(fld, "/", "")
End If
End If
Next
rs.Update
rs.MoveNext
Loop
rs.Close
End Sub

میتونی این روال رو بعد از کد Call AppendData("tblMain", "tblExcel") فراخوانی کنی

[moustafa]

خواهش میکنم
پیشنهاد میکنم با توجه به توضیحاتی که در پست 21 داده ام از نمونه پست 22 استفاده کنی


در خصوص تغییر فرمت فیلدهای عددی و تاریخ هم با توجه به اینکه جدول tblEtelate_peymankari بر خلاف جدول tblExcel که در خلال انتقال اطلاعات ایجاد میشه ثابته و خصوصیات فیلدهای اون هم ثابته میتوانی ابتدا فرمت فیلدهای جدول فوق رو مطابق خواسته خودت تغییر بدی و برای حذف علامت کاما از فیلدهای عددی و اسلش از فیلدهای تاریخ میتوانی از کدهای روال زیر استفاده کنی:


Public Sub ConvertField()
On Error Resume Next
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Set rs = CurrentDb.OpenRecordset("tblEtelate_peymankari")
Do While Not rs.EOF
rs.Edit
For Each fld In rs.Fields
If Not IsNull(fld) Then
If fld.Name Like "*mablagh*" Then
fld = Replace(fld, ",", "")
ElseIf fld.Name Like "*tarikh*" Then
fld = Replace(fld, "/", "")
End If
End If
Next
rs.Update
rs.MoveNext
Loop
rs.Close
End Sub

میتونی این روال رو بعد از کد Call AppendData("tblMain", "tblExcel") فراخوانی کنی

با تشکر . چون فیلدهای مبلغ و تاریخ رو در جدول اصلی عددی تعریف کردیم با توجه به اینکه فیلدهای جدول اکسل ایمپورتی از نوع متنی هستن بنابراین خطای دیتا تایپ میده و اطلاعات الحق نمیشه

[moustafa]

به جهت یکسان سازی نوع داده ها و جلوگیری از ورود اطلاعات تکراری با چندین شرط (چون نمیدونم چه فیلدی یونیکه با توجه به شرایط خودمون و عمومیت مسئله ) با اجازه تون من کدهای شما و خودمو تلفیق کردم (فعلاشروط کنترل اطلاعات تکراری رو تکی گذاشتم)

Private Sub btnBargozari_Click()
Dim dbs As DAO.Database
Dim td As DAO.TableDef
Dim fso As New FileSystemObject
If Nz(Me.txtFileName, "") = "" Then
MsgBox ("áØÝÇ í˜ ÝÇíá ÇäÊÎÇÈ ˜äíÏ")
Exit Sub
End If
If fso.FileExists(Nz(Me.txtFileName, "")) Then
Set dbs = CurrentDb
For Each td In dbs.TableDefs
If td.Name = "tblEtelate_peymankariTemp" Then
dbs.Execute "Drop Table tblEtelate_peymankariTemp;"
End If
Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "tblEtelate_peymankariTemp", txtFileName, True


CurrentDb.TableDefs("tblEtelate_peymankariTemp").Fields(0).Name = "f1"

DoCmd.RunSQL "DELETE * FROM tblEtelate_peymankariTemp WHERE (f4 =""ÝÕá"")"
Call ConvertField2
Dim rs1, rs As DAO.Recordset
Dim k As Long
Dim s, i As Integer
k = Nz(DMax("ID", "tblEtelate_peymankari"), 0) + 1
Set rs1 = CurrentDb.OpenRecordset("tblEtelate_peymankariTemp")
Set rs = CurrentDb.OpenRecordset("Select * From tblEtelate_peymankari")
DoCmd.SetWarnings False

If Not (rs1.EOF And rs1.BOF) Then

rs1.MoveFirst
s = 0
Do Until rs1.EOF = True
If DCount("*", "tblEtelate_peymankari", "code_rojo='" & rs1!f2 & "'") = 0 Then
rs.AddNew
rs!Id = k
For i = 0 To rs1.Fields.Count - 1
If Not IsNull(rs1.Fields(i)) Then
rs.Fields(i + 1) = rs1.Fields(i)
End If
Next
rs.Update
s = s + 1
k = k + 1
End If
rs1.MoveNext

Loop
MsgBox ("ÊÚÏÇÏ" & s & "јæÑÏ ÌÏíÏ Èå ÌÏæá ÓÝÇÑÔ ÈÇ ãæÝíÊ ÇÖÇÝå ÔÏ")

DoCmd.SetWarnings True

End If

rs1.Clone
Set rs1 = Nothing
rs.Clone
Set rs = Nothing


dbs.Execute "Drop Table tblEtelate_peymankariTemp;"


Set dbs = Nothing

End If

End Sub
و برای تغییر دیتا تایپ و حذف کاما و اسلش

Public Sub ConvertField2()


On Error Resume Next
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Set rst = CurrentDb.OpenRecordset("tblEtelate_peymankariTemp ")
Do While Not rst.EOF
rst.Edit
For Each fld In rst.Fields

If Not IsNull(fld) Then

If fld.TypeIsNumeric Then
fld = Replace(fld, ",", "")
fld = Replace(fld, "/", "")
End If
'
End If
Next
rst.Update
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

[moustafa]

----------------------

[moustafa]

تغییر نوع دادهای در جدول ایمپورتی

Public Sub ConvertField()
On Error Resume Next
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Set rst = CurrentDb.OpenRecordset("tblEtelate_peymankariTemp")
Do While Not rst.EOF
rst.Edit
For Each fld In rst.Fields

If Not IsNull(fld) Then

If fld.TypeIsNumeric Then
fld = Replace(fld, ",", "")
fld = Replace(fld, "/", "")
End If
'
End If
Next
rst.Update
rst.MoveNext
Loop
rst.Close

[eb_1345]

به جهت یکسان سازی نوع داده ها و جلوگیری از ورود اطلاعات تکراری با چندین شرط (چون نمیدونم چه فیلدی یونیکه با توجه به شرایط خودمون و عمومیت مسئله ) با اجازه تون من کدهای شما و خودمو تلفیق کردم (فعلاشروط کنترل اطلاعات تکراری رو تکی گذاشتم)

به نظر میرسه از ورژن نهائی آفیس استفاده می کنین ، چون من با آفیس 2016 موفق به باز کردن فایل نمونه ای که ضمیمه کرده این نشدم

[moustafa]

به نظر میرسه از ورژن نهائی آفیس استفاده می کنین ، چون من با آفیس 2016 موفق به باز کردن فایل نمونه ای که ضمیمه کرده این نشدم
فکر کنم اینطور باشه البته کدها رو گذاشتم جسارت نباشه شما استاد مائی در همون نمونه خودتون در همون فرم به یک باتن انتساب بدین همینطور کدهای پست 27 رو که من 2 ConvertField ذخیره کردم

[eb_1345]

به جهت یکسان سازی نوع داده ها و جلوگیری از ورود اطلاعات تکراری با چندین شرط (چون نمیدونم چه فیلدی یونیکه با توجه به شرایط خودمون و عمومیت مسئله ) با اجازه تون من کدهای شما و خودمو تلفیق کردم (فعلاشروط کنترل اطلاعات تکراری رو تکی گذاشتم)



فکر کنم اینطور باشه البته کدها رو گذاشتم جسارت نباشه شما استاد مائی در همون نمونه خودتون در همون فرم به یک باتن انتساب بدین همینطور کدهای پست 27 رو که من 2 ConvertField ذخیره کردم

در کدهای تلفیقی خودتون هم خطای دیتا تایپ صادر میشه و اطلاعات به جدول اصلی اضافه نمیشه
من نمونه پست 21 رو اصلاح و در این پست ضمیمه میکنم
در این نمونه دیتا تایپ فیلدهای تاریخ و مبالغ رو در جدول tblEtelate_peymankari به عدد(Number) تغییر دادم . و در قسمت کد نویسی هم کدهای روال ConvertField رو بصورت زیر تغییر دادم :


Public Sub ConvertField()
'On Error Resume Next
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Set rs = CurrentDb.OpenRecordset("tblEtelate_peymankariTemp")
Do While Not rs.EOF
rs.Edit
For Each fld In rs.Fields
If Not IsNull(fld) Then
fld = Replace(fld, ",", "")
fld = Replace(fld, "/", "")
End If
Next
rs.Update
rs.MoveNext
Loop
rs.Close
End Sub

در تغییر جدید بجای اینکه علامت کاما و ممیز رو از فیلدهای عددی جدول tblEtelate_peymankari حذف کنیم میایم همین کار رو فقط با شرط خالی نبودن فیلدها برای همه فیلدهای جدول موقت tblEtelate_peymankariTemp انجام میدیم
یعنی با این کار بمحض اینکه جدول موقت tblEtelate_peymankariTemp ایجاد شد قبل از انتقال اطلاعات اون به جدول اصلی علامت های فوق رو از کلیه فیلدهای این جدول حذف میکنیم
حالا بدون هیچ مشکلی در نوع دیتا تایپ فیلدهای دو جدول انتقال صورت میگیره ( البته باید به اندازه طول فیلدهای عددی جدول اصلی توجه بشه که طول اونها کمتر از طول واقعی فیلدهای تکست جدول موقت نباشه)
عنایت داشته باشین در نمونه اصلاح شده جدید مطابق توضیحات پست 21 بر اساس فیلد code_rojo اطلاعات دو جدول با هم مقایسه و انتقال صورت میگیره .بالاخره برای مقایسه اطلاعات دو جدول حداقل نیاز به یک کد مشترک در هر دو جدول میباشه

[moustafa]

خطایی که در کدهای من روی میده ولی برای شما نشون نمیده
مسیج تریسی که نوشتم نام فیلد مقصد ،اندازه فیلد مبدا ،مقدار فیلد مبدا :
156229
نشون میده که در فیلد تاریخ سند حسابداری ظاهر ا ده بار اسپیس وارد شده و منطقیه که داده رشته ای با کاراکتر غیر عددی نمی تونه وارد داده عددی بشه
156230
156231

[moustafa]

در سابروتین حذف کاراکترها کاما و اسلش چون بعضی فیلدها مثل شماره قرارداد ممکنه دارای اسلش باشن اونا روهم با شرط null ترکیب کردم

Public Sub ConvertField2()


'On Error Resume Next
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Set rst = CurrentDb.OpenRecordset("tblEtelate_peymankariTemp ")
Do While Not rst.EOF
rst.Edit
For Each fld In rst.Fields

If Not IsNull(fld) And fld.Name <> "F20" Then

'If fld.TypeIsNumeric Then
fld = Replace(fld, ",", "")
fld = Replace(fld, "/", "")
' End If
'
End If
Next
rst.Update
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

[eb_1345]

خطایی که در کدهای من روی میده ولی برای شما نشون نمیده

نشون میده که در فیلد تاریخ سند حسابداری ظاهر ا ده بار اسپیس وارد شده و منطقیه که داده رشته ای با کاراکتر غیر عددی نمی تونه وارد داده عددی بشه


سلام آقا مصطفی عزیز!
نمونه پست 30 رو امتحان کردین ؟
من خواهش میکنم همون نمونه پست 30 رو با دقت بررسی و امتحان کنین و ایراد مربوطه رو مطرح بفرمائین که اگه قابل برطرف شدن باشه برطرف کنیم که ان شاءاالله زودتر موضوع این تاپیک با موفقیت خاتمه پیدا کنه . کد خاصی هم که مد نظرتونه در حد امکان با کدهای نمونه فوق فعلاً تلفیق نکنین ! چون ممکنه بررسی مجدد رو یک مقداری سختتر کنه
من نمونه فوق رو سیستم خودم امتحان کردم و بدون هیچ مشکلی اطلاعات منتقل میشه



در سابروتین حذف کاراکترها کاما و اسلش چون بعضی فیلدها مثل شماره قرارداد ممکنه دارای اسلش باشن اونا روهم با شرط null ترکیب کردم

اتفاقاً حواسم به این مورد هم بود و فکر کردم چون علامت اسلش در شماره قرارداد بعد از عدد دوم درج میشه فکر کردم شاید بخواهی در جدول اصلی در قسمت Input Mask این علامت رو لحاظ کنین ولی الآن وقتی به تعداد ارقام شماره قرارداد دقت کردم دیدم تعداد ارقام اون در بعضی قراردادها با هم فرق میکنه . بنابراین این شرطی که در سابروتین بکار برده این حتماً لازمه

[moustafa]

سلام آقا مصطفی عزیز!
نمونه پست 30 رو امتحان کردین ؟
من خواهش میکنم همون نمونه پست 30 رو با دقت بررسی و امتحان کنین و ایراد مربوطه رو مطرح بفرمائین که اگه قابل برطرف شدن باشه برطرف کنیم که ان شاءاالله زودتر موضوع این تاپیک با موفقیت خاتمه پیدا کنه . کد خاصی هم که مد نظرتونه در حد امکان با کدهای نمونه فوق فعلاً تلفیق نکنین ! چون ممکنه بررسی مجدد رو یک مقداری سختتر کنه
من نمونه فوق رو سیستم خودم امتحان کردم و بدون هیچ مشکلی اطلاعات منتقل میشه



اتفاقاً حواسم به این مورد هم بود و فکر کردم چون علامت اسلش در شماره قرارداد بعد از عدد دوم درج میشه فکر کردم شاید بخواهی در جدول اصلی در قسمت Input Mask این علامت رو لحاظ کنین ولی الآن وقتی به تعداد ارقام شماره قرارداد دقت کردم دیدم تعداد ارقام اون در بعضی قراردادها با هم فرق میکنه . بنابراین این شرطی که در سابروتین بکار برده این حتماً لازمه


عرض ادب جناب بهرامی
بله برنامه شما دقیقا کار میکنه دست مریزاد و خسته نباشین :تشویق::تشویق::قلب::قلب:
حتی من جدول شما رو بخاطر تنظیماتی که داده بودین امیپورت کردم متاسفانه برا منم باز کار نکردمگه اینکه تو فایل اکسل داده های بظاهر خالی رو حذف کنی که اونم در فایل اصلی نمیشه بنابراین در یه فایل اکسل دیگه کپی کردم و تغییرات انجام دادم اطلاعات وارد شد .
اصرار من در الحاق تکی رکوردها به جای کلی برا اینه که از شیطنتها و سهل انگاری های رو بشه کنترل و ردیابی کرد حالا داده های تکراری علی الخصوص با یک شرط علیرغم یونیک بودن راحت میشه چندین کپی از اون وارد کرد ....بیشتر از جنبه کنترلی و تعمیم به مورد های احتمالی آینده

[eb_1345]

عرض ادب جناب بهرامی
بله برنامه شما دقیقا کار میکنه دست مریزاد و خسته نباشین :تشویق::تشویق::قلب::قلب:
حتی من جدول شما رو بخاطر تنظیماتی که داده بودین امیپورت کردم متاسفانه برا منم باز کار نکردمگه اینکه تو فایل اکسل داده های بظاهر خالی رو حذف کنی که اونم در فایل اصلی نمیشه بنابراین در یه فایل اکسل دیگه کپی کردم و تغییرات انجام دادم اطلاعات وارد شد .
اصرار من در الحاق تکی رکوردها به جای کلی برا اینه که از شیطنتها و سهل انگاری های رو بشه کنترل و ردیابی کرد حالا داده های تکراری علی الخصوص با یک شرط علیرغم یونیک بودن راحت میشه چندین کپی از اون وارد کرد ....بیشتر از جنبه کنترلی و تعمیم به مورد های احتمالی آینده

خب ، خدا رو شکر
پس با این وجود فعلاً مشکل خاصی وجود نداره؟

[moustafa]

خب ، خدا رو شکر
پس با این وجود فعلاً مشکل خاصی وجود نداره؟
بله واگه بشه رکوردها بجای اینکه یکجا وارد بشنه تک تک با شروطی که براشون تعریف میکنم وارد بشن خیلی عالی میشه . چون در آینده این امکان وجود داره که فیلد جدید اضافه بشه و شروط مخصوص بخودش رو داشته باشه

[eb_1345]

بله واگه بشه رکوردها بجای اینکه یکجا وارد بشنه تک تک با شروطی که براشون تعریف میکنم وارد بشن خیلی عالی میشه . چون در آینده این امکان وجود داره که فیلد جدید اضافه بشه و شروط مخصوص بخودش رو داشته باشه

برای شدن که میشه
کافیه عبارت شرطی رو به آخر کد ......INSERT INTO اضافه کنی
نمونه ضمیمه که اصلاح شده نمونه پست 30 است بررسی کن !
در نمونه فوق یک کمبو باکس در فرم ایجاد شده که مقادیر مربوط به کدهای رجوعی در اون درج شده . حالا بعد از انتقال اطلاعات از فایل اکسل به داخل برنامه کدی از کمبو باکس انتخاب و عمل انتقال به جدول اصلی انجام بده
همینطور میشه شرط های ترکیبی بیشتری رو ایجاد کرد

[moustafa]

جناب بهرامی فکر کنم کد زیر منظورمو بهتر برسونه شروط چند گانه و اجرای دستورات اس کیو ال شما برای هر رکورد .
دستورات اس کیو الی که شما نوشتین ظاهرا بطور هوشمند دیتاتایپها و وایت اسپیسها رو کنترل میکنه و اطلاعات رو سریعتر انتقال میده تا vba

If DCount("*", "tblEtelate_peymankari", "shenase_meli='" & rs1!shenase_meli & "'" & _
"and shomare_gharardad='" & rs1!shomare_gharardad & "'" & _
"and tarikh_gharardad ='" & rs1!tarikh_gharardad & "'" & _
"and sale_amalkard ='" & rs1!sale_amalkard & "'" & _
"and fasl ='" & rs1!fasl & "'" & _
"and shomare_sorat_vaziyat ='" & rs1!shomare_sorat_vaziyat & "'" & _
"and tarikh_sorat_vaziyat =" & rs1!tarikh_sorat_vaziyat & _
"and tarikh_taeide_sorat_vaziyat ='" & rs1!tarikh_taeide_sorat_vaziyat & "'" & _
"and mablagh_riyale_kole ='" & rs1!mablagh_riyale_kole & "'" & _
"and mablagh_r_maliyat_afzode ='" & rs1!mablagh_r_maliyat_afzode & "'" & _
"and mablagh_r_avarez_afzode ='" & rs1!mablagh_r_avarez_afzode & "'" & _
"and onvane_moadi_tarafe_aval ='" & rs1!onvane_moadi_tarafe_aval & "'") = 0 Then
For i = 0 To rs1.Fields.Count - 1
StrSql = "INSERT INTO " & MainTable & " (" & FldName & ")SELECT " & Fld1Select & " FROM " & ExcelTable & " where code_rojo='" & CombCode & "'" where کورد i ام
DoCmd.RunSQL StrSql
next