تطبیق عبارات Declare فایل های اکسس با سیستم ویندوز

[Abbas Amiri]

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

Sub Win32_64DeclareCompatible(DBName As String)
Dim App As Access.Application
Dim db As DAO.Database
Dim mdl As Module
Dim lStr As String, rStr As String, i As Long, j As Long, ChangedNum As Integer
Dim strOldText As String, strNewText As String
#If Win64 Then
strOldText1 = "Declare Function"
strNewText1 = "Declare Ptrsafe Function"
strOldText2 = "Declare Sub"
strNewText2 = "Declare Ptrsafe Sub"
#Else
strOldText1 = "Declare Ptrsafe Function"
strNewText1 = "Declare Function"
strOldText2 = "Declare Ptrsafe Sub"
strNewText2 = "Declare Sub"
#End If
Set App = New Access.Application
'On Error Resume Next
strPWD = InputBox("در صورت وجود پسورد، آنرا تايپ کنيد")

App.OpenCurrentDatabase DBName, , strPWD
'App.Visible = False
Set db = App.CurrentDb
cnt = db.Containers("Modules").Documents.Count - 1


For k = 0 To cnt
DoEvents
snam = db.Containers("Modules")(k).Name
App.DoCmd.OpenModule (snam)

Set mdl = App.Modules(snam)
With mdl

For i = 1 To .CountOfLines
If .Find(strOldText1, i, 1, i, -1) Then
j = InStr(.Lines(i, 1), strOldText1) - 1
lStr = Left(.Lines(i, 1), j)
rStr = Right(.Lines(i, 1), Len(.Lines(i, 1)) - j - Len(strOldText1))
.ReplaceLine i, lStr & strNewText1 & rStr
ChangedNum = ChangedNum + 1
End If
If .Find(strOldText2, i, 1, i, -1) Then
j = InStr(.Lines(i, 1), strOldText2) - 1
lStr = Left(.Lines(i, 1), j)
rStr = Right(.Lines(i, 1), Len(.Lines(i, 1)) - j - Len(strOldText2))
.ReplaceLine i, lStr & strNewText2 & rStr
ChangedNum = ChangedNum + 1
End If

Next

End With
DoCmd.Close acModule, snam
Next
Set oDoc = Nothing
Set mdl = Nothing
Set db = Nothing
App.Quit acQuitSaveAll
Set App = Nothing
MsgBox ChangedNum & " Expression Changed"

End Sub

[abdoreza57]

سلام

میشه در مورد این مطلب ، ساده تر توضیح بدید ؟ اساسا این مشکل چطور به وجود میاد و چه مفهومی دارده

ممنون

[Abbas Amiri]

سلام

میشه در مورد این مطلب ، ساده تر توضیح بدید ؟ اساسا این مشکل چطور به وجود میاد و چه مفهومی دارده

ممنون

سلام
به تاپیک حل مشکل ماژول ها در 64 و 32 بیتی (http://barnamenevis.org/showthread.php?491505-%D8%AD%D9%84-%D9%85%D8%B4%DA%A9%D9%84-%D9%85%D8%A7%DA%98%D9%88%D9%84-%D9%87%D8%A7-%D8%AF%D8%B1-64-%D9%88-32-%D8%A8%DB%8C%D8%AA%DB%8C) مراجعه کنید تا بیشتر در جریان موضوع قرار گیرید
روتین فوق فایل اکسسی که دارای مشکل اینچنینی باشد را بسته به سیستم 64 بیتی و یا 32 بیتی اصلاح میکند

[G.hemati]

با سلام و ممنون از زحمات استاد امیری و تمامی دوستانی که زحماتشون قابل تقدیره



این کد را بادر یک محیط VBA غیر فایلی که میخواهیم تغییر دهیم اجرا کنیم .

1- من منظور استاد رو کامل متوجه نشدم. آیا یه برنامه باید درست کنیم که توسط اون فایلهای دارای مشکل رو انتخاب کرده و رفع مشکل کنیم

یا در ماژول داخل خود برنامه استفاده کنیم.

2- آیا با این کار سیستم 32 بیتی هم کار میکنه

[G.hemati]

اساتید گرامی نظری ندارن؟؟؟

[Abbas Amiri]

با سلام و ممنون از زحمات استاد امیری و تمامی دوستانی که زحماتشون قابل تقدیره



1- من منظور استاد رو کامل متوجه نشدم. آیا یه برنامه باید درست کنیم که توسط اون فایلهای دارای مشکل رو انتخاب کرده و رفع مشکل کنیم

یا در ماژول داخل خود برنامه استفاده کنیم.

2- آیا با این کار سیستم 32 بیتی هم کار میکنه

سلام
این کد رو برای مواقعی نوشتم که چنانچه از منبعی یک فایل اکسس داشته باشیم و دارای عبارات Declare متعدد در ماژول های آن باشد و از عبارات شرطی پیش پردازنده جهت انتخاب Syntax مناسب سیستم استفاده نشده باشد، بتوانیم بدون توجه به 64 و 32 بیتی بودن سیستم خودمان ، کدهای مورد نظر را سازگار کنیم .
برای استفاده از کد های بالا بایستی در یک فایل اکسس دیگر آنرا اجرا کرد و مسیر کامل فایل مورد نظر را به عنوان آرگومان تابع بکار برد.
لازم به تذکر است که فقط در فایلهایی که برای اولین بار اجرا و ناسازگاری وجود داشته باشد ، احتیاج به استفاده از کدهای فوق می باشد .
برای برنامه هایی که می نویسید از روشی که در تاپیک حل مشکل ماژول ها در 64 و 32 بیتی (http://barnamenevis.org/showthread.php?491505-%D8%AD%D9%84-%D9%85%D8%B4%DA%A9%D9%84-%D9%85%D8%A7%DA%98%D9%88%D9%84-%D9%87%D8%A7-%D8%AF%D8%B1-64-%D9%88-32-%D8%A8%DB%8C%D8%AA%DB%8C) آمده، استفاده کنید

[emami.sie]

با سلام و عرض ادب خدمت دوستان
ابتدا جا داره از زحمات استاد عزیزمون جناب امیری کمال تشکر رو داشته باشم و آرزو دارم خداوند بهشون سلامتی و طول عمر عطا کنه...
عرض کنم خدمت دوستان، من چون خودم مبتدی هستم و گفتم شاید برخی از دوستان دیگه هم نتونن از این ماژول به صورت صحیح استفاده کنن، اون رو با اجازه استاد در یک برنامه کوچیک قرار دادم تا براحتی قابل استفاده باشه...
موفق و مؤید باشید
یا علی

[Abbas Amiri]

با سلام و عرض ادب خدمت دوستان
ابتدا جا داره از زحمات استاد عزیزمون جناب امیری کمال تشکر رو داشته باشم و آرزو دارم خداوند بهشون سلامتی و طول عمر عطا کنه...
عرض کنم خدمت دوستان، من چون خودم مبتدی هستم و گفتم شاید برخی از دوستان دیگه هم نتونن از این ماژول به صورت صحیح استفاده کنن، اون رو با اجازه استاد در یک برنامه کوچیک قرار دادم تا براحتی قابل استفاده باشه...
موفق و مؤید باشید
یا علی

سلام
دست شما درد نکند . 2 مورد بود که لطف کنید اعمال شود. اول چون باید در هر دو نوع 64 و 32 بیتی استفاده شود از عبارات شرطی پیش پردازنده استفاده کنید و دوم در ویندوز8 و 64 بیتی کادر انتخاب فایل جواب نداد . از dialogFile آفیس استفاده کنید تا مشکلی نباشد. البته پشینهاد بود انتخاب روش با خودتان.
ضمنا می توان با کمی تلاش کدها برای گنجاندن عبارات شرطی پیش پردازنده ، بهینه کرد .
موفق باشید

[emami.sie]

سلام
دست شما درد نکند . 2 مورد بود که لطف کنید اعمال شود. اول چون باید در هر دو نوع 64 و 32 بیتی استفاده شود از عبارات شرطی پیش پردازنده استفاده کنید و دوم در ویندوز8 و 64 بیتی کادر انتخاب فایل جواب نداد . از dialogFile آفیس استفاده کنید تا مشکلی نباشد. البته پشینهاد بود انتخاب روش با خودتان.
ضمنا می توان با کمی تلاش کدها برای گنجاندن عبارات شرطی پیش پردازنده ، بهینه کرد .
موفق باشید

با سلام مجدد خدمت دوستان و اساتید محترم
طبق فرمایش جناب امیری اصلاحات رو انجام دادم...
فقط یه موضوع که خود جناب امیری هم بهش اشاره داشتن اینه که اگه بشه کدها رو یه جوری بسط داد که دستورات شرطی هم درش گنجانده بشه خیلی عالیه، چون من خودم الان حدود 10 تا برنامه طراحی کردم و دست چندین کاربره و اگه بخوام یکی یکی دستورات شرطی 64 و 32 بیتی رو درش اعمال کنم وحشتناک کار میبره، چون هر کدومش حدود 100 تا 150 تا عبارت Declare داره...
موفق و مؤید باشید
یا علی

[Abbas Amiri]

با سلام مجدد خدمت دوستان و اساتید محترم
طبق فرمایش جناب امیری اصلاحات رو انجام دادم...
فقط یه موضوع که خود جناب امیری هم بهش اشاره داشتن اینه که اگه بشه کدها رو یه جوری بسط داد که دستورات شرطی هم درش گنجانده بشه خیلی عالیه، چون من خودم الان حدود 10 تا برنامه طراحی کردم و دست چندین کاربره و اگه بخوام یکی یکی دستورات شرطی 64 و 32 بیتی رو درش اعمال کنم وحشتناک کار میبره، چون هر کدومش حدود 100 تا 150 تا عبارت Declare داره...
موفق و مؤید باشید
یا علی


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

Option Compare Database

Dim CountLines As Long
'************************************************* ********************************
Sub Win32_64DeclareCompatible(DBName As String)
Dim App As Access.Application, cnt As Long, LastLine As Long, mdlLineCount As Long
Dim db As DAO.Database, strDeclare As String
Dim mdl As Access.Module, mdlName As String, preProcLine As Long
Dim i As Long, j As Long, ChangedNum As Integer, strPWD As String
Set App = New Access.Application
strPWD = InputBox("در صورت وجود پسورد، آنرا تايپ کنيد")
App.OpenCurrentDatabase DBName, , strPWD
Set db = App.CurrentDb
cnt = db.Containers("Modules").Documents.Count - 1
For k = 0 To cnt
DoEvents
mdlName = db.Containers("Modules")(k).Name
App.DoCmd.OpenModule (mdlName)
Set mdl = App.Modules(mdlName)
With mdl
'Debug.Print mdlName
i = 1
preProcLine = 0
mdlLineCount = .CountOfLines
LastLine = i
Do While i < mdlLineCount
startSearch:
.Find "#If Win64", preProcLine, 1, preProcLine, -1
If .Find("Declare", i, 1, i, -1) Then

If preProcLine And i > preProcLine And LastLine < preProcLine Then
If i < LastLine Then Exit Do
i = preProcLine
.Find "#END If", i, 1, i, -1
preProcLine = i
LastLine = i
GoTo startSearch
End If
If i < LastLine Then Exit Do
strDeclare = EntireDeclareExpression(mdl, i)
If strDeclare <> "" Then
strDeclare = CreateConditional(strDeclare)
.DeleteLines i, CountLines
.InsertLines i, strDeclare
i = i + CountLines * 2 + 2
Else
i = i + 1
End If
mdlLineCount = mdl.CountOfLines
LastLine = i
preProcLine = i
ChangedNum = ChangedNum + 1
Else
Exit Do
End If
Loop
End With
DoCmd.Close acModule, mdlName, acSaveYes
Next
Set mdl = Nothing
Set db = Nothing
App.Quit acQuitSaveAll
Set App = Nothing
MsgBox "تعداد " & ChangedNum & " عبارت Declare جهت هماهنگي با" & vbCr & _
"سيستم هاي 32 و 64 بيتي آپديت شد"
End Sub
'************************************************* ********************************
Private Function EntireDeclareExpression(mdl As Module, iLine As Long) As String
Dim s As String
CountLines = 1
With mdl
mdl.Find "Declare", iLine, 1, -1, -1
s = vbTab & LTrim(.Lines(iLine, CountLines))
k = InStr(1, s, "'", vbTextCompare) 'Check quotation marks if Declare used in comments
If InStr(1, s, "Declare", vbTextCompare) > k And k > 0 Then
EntireDeclareExpression = ""
Exit Function
End If
Do While Right(s, 1) = "_"
CountLines = CountLines + 1
.ReplaceLine iLine + CountLines - 1, vbTab & LTrim(.Lines(iLine + CountLines - 1, 1))
s = vbTab & LTrim(.Lines(iLine, CountLines))
Loop
End With
EntireDeclareExpression = s
End Function
'************************************************* *******************
Private Function CreateConditional(strDeclare As String) As String
Dim s As String
s = "#If Win64 Then" & vbCr
s = s & AddPtrsafe(strDeclare) & vbCr
s = s & "#Else" & vbCr
s = s & DelPtrsafe(strDeclare) & vbCr
s = s & "#End If" & vbCr
CreateConditional = s
End Function
'************************************************* *******************
Private Function AddPtrsafe(strDeclare As String) As String
Dim i As Integer, lStr As String, rStr As String
i = InStr(1, strDeclare, "Ptrsafe", vbTextCompare)
If i = 0 Then
AddPtrsafe = Replace(strDeclare, "Declare", "Declare Ptrsafe", , , vbTextCompare)
Else
AddPtrsafe = strDeclare
End If
End Function
'************************************************* *******************
Private Function DelPtrsafe(strDeclare As String) As String
DelPtrsafe = Replace(strDeclare, "Ptrsafe", "", , , vbTextCompare)
End Function

[emami.sie]

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

با سلام خدمت دوستان
ابتدا باید بگم جناب امیری شما فوق العاده اید، واقعا لذت می برم از این همه استعداد و تشکر می کنم از این همه لطفی که در حق ما می کنید...
طبق فرمایش شما نمونه رو با توابع جدید بروز کردم...
فقط چند مورد که اول عذر خواهی می کنم بابت این همه مزاحمت
1- یک تغییر کوچیک دربرنامه دادم تا پیغام خطایی که در صورت یافتن عبارت #if win64 then متوقف میشد رد بشه، چون ممکنه کسی تو برنامش چندتا از عباراتش رو اصلاح کرده باشه و یا ماژول آماده ای رو کپی کرده باشه که درش از این عبارات استفاده شده...
2- در یکی از برنامه هام که این توابع رو تست کردم از حدود 100 عبارت Declare، تعداد 18 تا از عبارات Declare در ماژول ها اصلاح نشد که هر چی دنبال علت (یا یک دلیل منطقی) گشتم موفق نشدم... (تصویر ذیل یکی از نمونه هاشه؛ که در یک ماژول 3 تا از عبارت اصلاح نشده و مابقی اصلاح شده است)
135114

3- برخی از عبارات Declare در فرمها موجوده؛ و این توابع فقط برای ماژول مورد استفادست. خیلی سعی کردم که به فرمها هم بسطش بدم اما موفق نشدم، استدعا دارم استاد زحمت این رو هم بکشن تا یه نمونه جامع بشه و همه ازش استفاده کنن...
باز هم از زحمات آقای امیری تشکر می کنم
موفق و موید باشید
یا علی

[Abbas Amiri]

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

[emami.sie]

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

با سلام
طبق فرمایشتون نمونه ای رو ضمیمه کردم
تشکر
یا علی

[Abbas Amiri]

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

Sub frmModuleDeclareCompatible(App As Access.Application)
Dim cnt As Long, LastLine As Long, mdlLineCount As Long
Dim db As DAO.Database, strDeclare As String
Dim mdl As Access.Module, mdlName As String, preProcLine As Long
Dim i As Long, j As Long, ChangedNum As Integer, strPWD As String

Set db = App.CurrentDb
'cnt = db.Containers("Modules").Documents.Count - 1
cnt = App.Modules.Count - 1
For k = 0 To cnt
mdlName = App.Modules(k).Name
Set mdl = App.Modules(mdlName)
If mdl.Type = acClassModule Then
With mdl
.
.
.
.
.
End With
End If
Next k
Set mdl = Nothing
Set db = Nothing
App.Quit acQuitSaveAll
Set App = Nothing
End Sub


قبل از اینکه در روال Win32_64DeclareCompatible به عبارت Set App = Nothing برسید روال جدید را فراخوانی کنید و App را به آن پاس کنید.
کد را امتحان نکردم ولی مطمئن با کمی دستکاری جواب می دهد

[emami.sie]

سلام
کدهای پست 10 تصحیح شد . در این کدها زمانی که به دستورات شرطی سیستم ویندوز برسد از آن عبور می کند.
برای فرم ها یک روتین دیگر از Win32_64DeclareCompatible با نام دلخواه کپی کنید و مانند زیر تغییر دهید.
...

قبل از اینکه در روال Win32_64DeclareCompatible به عبارت Set App = Nothing برسید روال جدید را فراخوانی کنید و App را به آن پاس کنید.
کد را امتحان نکردم ولی مطمئن با کمی دستکاری جواب می دهد

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