با سلام
توسط کدهای زیر از طریق اکسس یک فایل مشخص روبا اکسس باز می کنیم و می خوایم یک کاربرگ جدید ایجاد کنیم که اطلاعات کاربرگی که پروتکت شده است بریزیم توش برای ویرایش و امیپورت به اکسس
Untitled7.png
که بعضا با خطای زیر مواجهه میشم و بعضا با زدن end و اجرا کردن مجدد کد دیگه خطا نمیده و عملیات اجرا میشه
Untitled6.png
به این کد هم اصلاح کردم بازم مشکل پابرجاست
wrk.Sheets.Add After:=ActiveSheet
سلام و روز خوش
بنظر میاد فایل مدتی زمان میبره تا کامل خونده بشه،
یا در دسترس بشه (جای دیگه lock شده ؟؟).
شاید هم مشکل شبکه (فایل روی اینترنت ؟؟) یا درایو کند هست.
عرض ادب استاد وسرور گرامی. اون وقت چرا برای بار دوم که بلافاصله کد باتن مربوطه رو میزنم بدون خطا اجرا میشه ؟ رو لپ تاپ خونگیم که 16 گیگ رم و هاراد 552 اس اس دی داره بطور اف لاین هم این مشکل پیش میاد ! تازه کدهای بعدیش که چندین فانکشن بررسی و تحلیل و محاسبات و رکوردست مقایسه ای هستش به سرعت اجرا میشه .نوشته شده توسط mazoolagh
vba مثل پایتون تابع sleep برای وقفه دادن نداره ؟
با سپاس و تشکر فراوان از اینهمه خوبی
در ادامه این خطا پیش میاد بنظر اشیا Set نمیشن !!
Untitled8.png
Untitled9.png
مشخصا اون worksheet به اسم info رو پیدا نمیکنه.
اینجوری دیباگ کنین:
بعد از set شدن xlapp یک break-point بذارین و در immediate اینها رو اجرا کنین
? xlapp.worksheets.count
? xlapp.worksheets(1).name
نحوه کار اینطوره که ما میخوایم از یک فایل اکسل اطلاعات یک کاربرگی که اسمش فارسی ،عنوان ستونهاش فارسی و پروتکت شده است داخل اکسس ایمپورت و به جدول مربوطه الحاق کنیم .بخاطر پروتکت بودن(به لحاظ امنیتی دسترسی به پس ورو نخواهیم داشت) ناچارا یه کاربرگ جدید به اسم انگلیسی info ایجاد کنیم و اطلاعات رو از اون کاربرگ پروتکت شده کپی کنیم به اون وسپس عناوین ستونها رو مطابق نام جدولی که در اکسس داریم به انگلیسی تغییر بدیم و ایمپورت کنیم داخل اکسسس و اطلاعاتش رو به جدول اصلی مون الحاق کنیم . خطاهای ذکر شده موردی پیش میاد حتی بدون دیباگ و زدن دکمه end برای بار بعدی بدون خطا اجرا میشه . به ذهنم رسید که در کنترل خطا به لیبلی پاس بدم که فایل اکسل باز شده رو بدون ذخیره ببنده و مجددا کدها رو از اول اجرا کنه که جواب نداد یعنی حتما باید به اون پیام ارور جواب end رو بدی و برای بار بعد بدون خطا اجرا بشه
فایل رو ضمیمه کردم بی زحمت یه بررسی فرمائید frmAppend فرم مورد نظر وفایل اکسل که اول به فارسی بود به انگلیسی تغیر دادم در کنار برنامه اکسس
با سپاس وتشکر فراوان
سلام
وقت بخیر
برای انتقال اطلاعات شیت مورد نظر فایل اکسل به جدول مربوطه در فایل اکسس از کدهای زیادی استفاده کرده ای در صورتیکه میشه با تعداد کدهای به مراتب کمتر عملیات انتقال اطلاعات رو مستقیما از همون کاربرگی که دارای عنوان وستون های فارسی میباشه به جدول اصلی فایل اکسس انجام داد.
سلام ودرود جناب بهرامی عزیز
چنانچه زحمتی نباشه مشتاق یادگیری روش شما استاد وسرور گرامی رو همون فایل می باشم .
با سپاس و تشکر فراوان
آخرین ویرایش به وسیله moustafa : چهارشنبه 02 آبان 1403 در 13:29 عصر
ابتدا یک روال برای انتقال اطلاعات( شیت اطلاعات) به داخل فایل اکسس ایجاد می کنیم:
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 : چهارشنبه 25 مهر 1403 در 13:18 عصر
راستش من نمونه رو از جوانب مختلف امتحان نکردم . لذا چنانچه اگه مشکلی داشت که حتماً داره یا مواردی که مد نظرتونه که باید در کدهای مربوطه لحاظ بشه اطلاع بده تا نمونه رو اصلاح کنم
.................................................. ...........
آخرین ویرایش به وسیله eb_1345 : چهارشنبه 25 مهر 1403 در 17:05 عصر
ضمناً من در نمونه در جدول tblMain فیلد ID رو حذف کرده ام. اگر قراره این فیلد در جدول فوق وجود داشته باشه و برای اینکه این فیلد در لیست فیلدهائی که در متغییر FldName درج میشه قرار نگیره بجای عدد 1 در کد FldName = Right(FldName, Len(FldName) - 1)
عدد 5 جایگزین کن !
بسیار سپاسگذارم جناب بهرامی از اینهمه لطف و زحمت . بررسی ونتیجه رو عرض میکنم
ضمناً بخاطر اینکه در نمونه فوق بجای نام جدول tblEtelate_peymankari از نام tblMain استفاده کرده بودم نمونه رو مجدداً با همان نام tblEtelate_peymankari اصلاح کردم
1- ما به پس ورد هرگز دسترسی نخواهیم داشت اون سایتی که اطلاعات رو ازش دانلود می کنیم این امکان رو نداده بخاطر اینکه اطلاعات دستکاری نشه ضمنا خود فایل پس ورد نداره کاربرگ یا شیت 1 پس ورد داره
2- به نام فیلد ها به انگلیسی برای ساخت جستجو ،کوئری ،گزارش و فرم نیاز داریم که متحضرید با نام فارسی نمیشه کد نویسی کرد
ظاهراً در شیت 1 فقط عنوان ستون ها درج شده و اطلاعات اصلی شما در شیت اطلاعات درج شده . اطلاعات این شیت بدون در نظر گرفتن پسورد هم قابل انتقال به جدول اکسس می باشه.
پس در نتیجه مشکلی از این بابت نباید وجود داشته باشه
آخرین ویرایش به وسیله eb_1345 : چهارشنبه 25 مهر 1403 در 14:30 عصر
شما برای انجام مواردی فوق نیاز به جدول tblEtelate_peymankari خواهید داشت که نام فیلدهای جدول فوق هم لاتین میباشه .
جدول tblExcel هم صرفاً یک جدول موقت و واسطه که اطلاعات کاربرگ فایل اکسل رو به جدول tblEtelate_peymankari اضافه می کنه
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
آخرین ویرایش به وسیله eb_1345 : پنج شنبه 26 مهر 1403 در 05:55 صبح
جناب بهرامی تا قبل پست 19 مرحله به مرحله تریس کردم بسیار عالی و دلچسب و سریع وبدون خطا ....لذت بردم دستتون درد نکنه
و در جهت تکمیل شدن بحث:
5-فرمت فیلدهای مبالغ در قالب متنی و با کاما هستش در حالیکه به نوع عددی و بدون کاما نیاز دارم که جداکننده اش در خود اکسس تنظیم شده باشه و همینطور فیلدهای تاریخ هم از نوع متنی و شامل ممیز هستش که می خوایم اونم از نوع عددی و بدون ممیز وارد بشه و در خود اکسس با ماسک ممیز گذاشته بشه
با تشکر
در ارتباط با کد بالا که در واقع برای چک کردن اطلاعات تکراری از اون استفاده میشه این نکته رو باید اضافه کنم که اگه فیلد 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 : پنج شنبه 26 مهر 1403 در 11:26 صبح
نمونه جدیدتر با اعمال کد جایگزین شده پست قبل
در پوشه این نمونه یک فایل اکسل با نام Book1.xlsx وجود دارد که اطلاعات شیت اون قابل ویرایشه. برای امتحان اطلاعات این فایل رو تغییر بده و اون رو به فایل اکسس اضافه کن و نتیجه انتقال رو در جدول اصلی اکسس بررسی کن !
خواهش میکنم
پیشنهاد میکنم با توجه به توضیحاتی که در پست 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") فراخوانی کنی
با تشکر . چون فیلدهای مبلغ و تاریخ رو در جدول اصلی عددی تعریف کردیم با توجه به اینکه فیلدهای جدول اکسل ایمپورتی از نوع متنی هستن بنابراین خطای دیتا تایپ میده و اطلاعات الحق نمیشه
به جهت یکسان سازی نوع داده ها و جلوگیری از ورود اطلاعات تکراری با چندین شرط (چون نمیدونم چه فیلدی یونیکه با توجه به شرایط خودمون و عمومیت مسئله ) با اجازه تون من کدهای شما و خودمو تلفیق کردم (فعلاشروط کنترل اطلاعات تکراری رو تکی گذاشتم)
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").F ields(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 : جمعه 27 مهر 1403 در 03:51 صبح
----------------------
آخرین ویرایش به وسیله moustafa : جمعه 27 مهر 1403 در 03:04 صبح
تغییر نوع دادهای در جدول ایمپورتی
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
آخرین ویرایش به وسیله moustafa : جمعه 27 مهر 1403 در 01:52 صبح
به نظر میرسه از ورژن نهائی آفیس استفاده می کنین ، چون من با آفیس 2016 موفق به باز کردن فایل نمونه ای که ضمیمه کرده این نشدم
فکر کنم اینطور باشه البته کدها رو گذاشتم جسارت نباشه شما استاد مائی در همون نمونه خودتون در همون فرم به یک باتن انتساب بدین همینطور کدهای پست 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 اطلاعات دو جدول با هم مقایسه و انتقال صورت میگیره .بالاخره برای مقایسه اطلاعات دو جدول حداقل نیاز به یک کد مشترک در هر دو جدول میباشه
خطایی که در کدهای من روی میده ولی برای شما نشون نمیده
مسیج تریسی که نوشتم نام فیلد مقصد ،اندازه فیلد مبدا ،مقدار فیلد مبدا :
Untitled12.png
نشون میده که در فیلد تاریخ سند حسابداری ظاهر ا ده بار اسپیس وارد شده و منطقیه که داده رشته ای با کاراکتر غیر عددی نمی تونه وارد داده عددی بشه
Untitled13.png
Untitled14.png
آخرین ویرایش به وسیله moustafa : جمعه 27 مهر 1403 در 20:57 عصر
در سابروتین حذف کاراکترها کاما و اسلش چون بعضی فیلدها مثل شماره قرارداد ممکنه دارای اسلش باشن اونا روهم با شرط 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
سلام آقا مصطفی عزیز!
نمونه پست 30 رو امتحان کردین ؟
من خواهش میکنم همون نمونه پست 30 رو با دقت بررسی و امتحان کنین و ایراد مربوطه رو مطرح بفرمائین که اگه قابل برطرف شدن باشه برطرف کنیم که ان شاءاالله زودتر موضوع این تاپیک با موفقیت خاتمه پیدا کنه . کد خاصی هم که مد نظرتونه در حد امکان با کدهای نمونه فوق فعلاً تلفیق نکنین ! چون ممکنه بررسی مجدد رو یک مقداری سختتر کنه
من نمونه فوق رو سیستم خودم امتحان کردم و بدون هیچ مشکلی اطلاعات منتقل میشه
اتفاقاً حواسم به این مورد هم بود و فکر کردم چون علامت اسلش در شماره قرارداد بعد از عدد دوم درج میشه فکر کردم شاید بخواهی در جدول اصلی در قسمت Input Mask این علامت رو لحاظ کنین ولی الآن وقتی به تعداد ارقام شماره قرارداد دقت کردم دیدم تعداد ارقام اون در بعضی قراردادها با هم فرق میکنه . بنابراین این شرطی که در سابروتین بکار برده این حتماً لازمه
عرض ادب جناب بهرامی
بله برنامه شما دقیقا کار میکنه دست مریزاد و خسته نباشین
حتی من جدول شما رو بخاطر تنظیماتی که داده بودین امیپورت کردم متاسفانه برا منم باز کار نکردمگه اینکه تو فایل اکسل داده های بظاهر خالی رو حذف کنی که اونم در فایل اصلی نمیشه بنابراین در یه فایل اکسل دیگه کپی کردم و تغییرات انجام دادم اطلاعات وارد شد .
اصرار من در الحاق تکی رکوردها به جای کلی برا اینه که از شیطنتها و سهل انگاری های رو بشه کنترل و ردیابی کرد حالا داده های تکراری علی الخصوص با یک شرط علیرغم یونیک بودن راحت میشه چندین کپی از اون وارد کرد ....بیشتر از جنبه کنترلی و تعمیم به مورد های احتمالی آینده
خب ، خدا رو شکرعرض ادب جناب بهرامی
بله برنامه شما دقیقا کار میکنه دست مریزاد و خسته نباشین
حتی من جدول شما رو بخاطر تنظیماتی که داده بودین امیپورت کردم متاسفانه برا منم باز کار نکردمگه اینکه تو فایل اکسل داده های بظاهر خالی رو حذف کنی که اونم در فایل اصلی نمیشه بنابراین در یه فایل اکسل دیگه کپی کردم و تغییرات انجام دادم اطلاعات وارد شد .
اصرار من در الحاق تکی رکوردها به جای کلی برا اینه که از شیطنتها و سهل انگاری های رو بشه کنترل و ردیابی کرد حالا داده های تکراری علی الخصوص با یک شرط علیرغم یونیک بودن راحت میشه چندین کپی از اون وارد کرد ....بیشتر از جنبه کنترلی و تعمیم به مورد های احتمالی آینده
پس با این وجود فعلاً مشکل خاصی وجود نداره؟
بله واگه بشه رکوردها بجای اینکه یکجا وارد بشنه تک تک با شروطی که براشون تعریف میکنم وارد بشن خیلی عالی میشه . چون در آینده این امکان وجود داره که فیلد جدید اضافه بشه و شروط مخصوص بخودش رو داشته باشه
برای شدن که میشه
کافیه عبارت شرطی رو به آخر کد ......INSERT INTO اضافه کنی
نمونه ضمیمه که اصلاح شده نمونه پست 30 است بررسی کن !
در نمونه فوق یک کمبو باکس در فرم ایجاد شده که مقادیر مربوط به کدهای رجوعی در اون درج شده . حالا بعد از انتقال اطلاعات از فایل اکسل به داخل برنامه کدی از کمبو باکس انتخاب و عمل انتقال به جدول اصلی انجام بده
همینطور میشه شرط های ترکیبی بیشتری رو ایجاد کرد
جناب بهرامی فکر کنم کد زیر منظورمو بهتر برسونه شروط چند گانه و اجرای دستورات اس کیو ال شما برای هر رکورد .
دستورات اس کیو الی که شما نوشتین ظاهرا بطور هوشمند دیتاتایپها و وایت اسپیسها رو کنترل میکنه و اطلاعات رو سریعتر انتقال میده تا 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
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول
