تطبیق عبارات 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