بسم الله الرحم الرحيم
سلام الله عليكم ورحمة منه وبركات
اسعد الله اوقاتكم بالمسرات قد تشرفت بزيارة موضوع الاخت زهرة بخصوص تخفيض امان الاكسس تحديدا تعطيل حماية الماكرو وقد استفدت من الموضوع ولكن الاشكالية هنا ان في الاكسس 2007 و 2010 لا يعمل الكود مالم يقوم المستخدم لاول مرة بتمكين المحتوى
المشكلة بعض المستخدمين لا يعلم بهذا الامر ولا يقوم بتمكين المحتوى :mad: حتى انه في معظم الاوقات لا يستفاد من البرنامج في حال بقاء امان الماكرو مرتفع او متوسط احدى الطرق كذلك كما تعلمون هو الوثوق بموقع قاعدة الاكسس حيث انه سيتم تعطيل امان الماكرو للبرامج التي توجد في مسار معين مثلا لو ان مسار قاعدة الاكسس يقع في C:\Users\Public وقمت بالوثوق به فان امان الماكرو يتعطل. اي موقع آخر لم يتم ادراجه للمواقع الموثوقة لن يعطل امان الماكرو
السؤال هنا هل هناك كود للوثوق التلقائي بموقع القاعدة اينما كانت ؟ :dry: وجدت كود في احد المواقع الاجنبية و على ما اظنه يقوم بهذه العملية لكن بسبب قلة خبرتي في التعامل مع مثل هذه الكواد اود ان اطرحه بين ايدكم لعلنا نستفيد منه في تخطي امان الماكرو واكواد vba
تعليق صاحب الكود
.اقتباسAccess 2007 and Access 2010 use trusted locations as a security measure to help prevent users opening a database from an unknown source which could include malicious code. Typically, if you open a database that is not in a trusted location, Access will display a security message asking if you want to open the file.
With the full version of Access trusted locations can be added manually using the trust centre, however this option is not available if your users only have Access RunTime. This article and code provide a means to add a trusted location automatically.
The code, which should be called as part of the start up routine, e.g. from the AutoExec macro, searches the registry to see if the the current location of the database is included in the trusted locations list. If it is, the code exits. If not, the code adds the location in the first available trusted location slot available in the registry.
If the database file is opened from a non trusted location the Access security warning will be displayed and the code run when the database opens. Subsequently, as the trusted location will have been added, the Access security warning will no longer be displayed
On Error GoTo err_proc
'WARNING: THIS CODE MODIFIES THE REGISTRY
'sets registry key for 'trusted location'
Dim intLocns As Integer
Dim i As Integer
Dim intNotUsed As Integer
Dim strLnKey As String
Dim reg As Object
Dim strPath As String
Dim strTitle as string
strTitle = "Add Trusted Location"
Set reg = CreateObject("wscript.shell")
strPath = CurrentProject.Path
'Specify the registry trusted locations path for the version of Access used
strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Format(Application.Version, "##,##0.0") & _
"\Access\Security\Trusted Locations\Location"
On Error GoTo err_proc0
'find top of range of trusted locations references in registry
For i = 999 To 0 Step -1
reg.RegRead strLnKey & i & "\Path"
GoTo chckRegPths 'Reg.RegRead successful, location exists > check for path in all locations 0 - i.
checknext:
Next
MsgBox "Unexpected Error - No Registry Locations found", vbExclamation
GoTo exit_proc
chckRegPths:
'Check if Currentdb path already a trusted location
'reg.RegRead fails before intlocns = i then the registry location is unused and
'will be used for new trusted location if path not already in registy
On Error GoTo err_proc1:
For intLocns = 1 To i
reg.RegRead strLnKey & intLocns & "\Path"
'If Path already in registry -> exit
If InStr(1, reg.RegRead(strLnKey & intLocns & "\Path"), strPath) = 1 Then GoTo exit_proc
NextLocn:
Next
If intLocns = 999 Then
MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation, strTitle
GoTo exit_proc
End If
'if no unused location found then set new location for path
If intNotUsed = 0 Then intNotUsed = i + 1
'Write Trusted Location regstry key to unused location in registry
On Error GoTo err_proc:
strLnKey = strLnKey & intNotUsed & "\"
reg.RegWrite strLnKey & "AllowSubfolders", 1, "REG_DWORD"
reg.RegWrite strLnKey & "Date", Now(), "REG_SZ"
reg.RegWrite strLnKey & "Description", Application.CurrentProject.Name, "REG_SZ"
reg.RegWrite strLnKey & "Path", strPath & "\", "REG_SZ"
exit_proc:
Set reg = Nothing
Exit Function
err_proc0:
Resume checknext
err_proc1:
If intNotUsed = 0 Then intNotUsed = intLocns
Resume NextLocn
err_proc:
MsgBox err.Description, , strTitle
Resume exit_proc
End Function
Public Function AddTrustedLocation()
الكود اظنه يحتاج بعض التعديل منها على ما اظن مسار البرنامج وغيرها مما لا علم لي بها :)
مصدر http://www.utteraccess.com/wiki/index.php/AddTrustedLocation