اذهب الي المحتوي
أوفيسنا

Trasted Location .. إنشاء موقع أمان لملفات الأكسيس توماتيكى

essam rabea

بواسطه essam rabea
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

essam rabea

essam rabea

قام بنشر
قام بنشر (معدل)

عجبنى الموضوع ده قلت أشاركه معكم

بإختصار هو سكريبت لعمل مكان موثوق لملفات الأكسيس من مكان تشغيله .. بمعنى لو شغلته من Desk Top تقدر تفتح أى ملف أكسيس على Desk Top بدون ظهور Enable Content.

ولو عندك فولدر لمشاريعك فى أى مكان سواء سى أو دى أو .... ضع هذا السكريبت داخله وشغل وخلاص بقى كل ما بداخل الفولدر منطقة أمان.

إنشئ ملف نص بأى إسم وضع فيه ما يلى على أن تغير إمتداده الى vbs.

Const HKEY_CURRENT_USER = &H80000001
 
    Dim oRegistry    
    Dim sPath    
    Dim sDescription    
    Dim bAllowSubFolders    
    Dim bAllowNetworkLocations    
    Dim bAlreadyExists    
    Dim sParentKey    
    Dim iLocCounter    
    Dim arrChildKeys    
    Dim sChildKey    
    Dim sValue    
    Dim sNewKey    

    Set WshShell = CreateObject("WScript.Shell")
    strCurDir = WshShell.CurrentDirectory

    Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
    sPath = strCurDir 

    sDescription = "YourTrustedLocationDescriptionGoesHere"
    bAllowSubFolders = True
    bAlreadyExists = False

    sParentKey = "Software\Microsoft\Office\16.0\Access\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\16.0\Excel\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\16.0\PowerPoint\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\16.0\Word\Security\Trusted Locations"
    iLocCounter = 0
    oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys
    For Each sChildKey in arrChildKeys
        oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue
         If sValue = sDescription Then bAlreadyExists = True

        If CInt(Mid(sChildKey, 9)) > iLocCounter Then
                iLocCounter = CInt(Mid(sChildKey, 9))
            End If
    Next

    'If bAlreadyExists = False Then
        sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1)

        oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey
        oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath
        oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription

        If bAllowSubFolders Then
            oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1

        End If

كما يمكن تفعيله للاكسيل والوورد والباور بوينت مع مراعاة نسخة الاوفيس لديك وتغيرها فى الكود:

أوفيس 2019     :   16.0

أوفيس 2016     :   16.0

أوفيس 2013    :    15.0

أوفيس 2010    :    14.0

أوفبس 2007    :    12.0

أوفيس 2003    :    11.0

أظن أنه لا يوجد أحد أعضاء منتدانا الكريم يعمل على أوفيس XP 😊

 

عسى أن يفيد .. إذا اشتغل يعنى

والله الموفق

 

EAR TrustAnyWhere.zip

تم تعديل بواسطه essam rabea
  • Like 11
  • Thanks 5
gelani

gelani

قام بنشر
قام بنشر

السلام عليكم ورحمة الله 

أسأل الله ان يزيدك علما وأن يحفظك من كل مكروه .

جربت الكود المرفق ويعمل لدي بصورة رائعة وحيث ما وضعت الملف المرفق يجعل الأكسس يعمل بالرغم من ان مستوى الأمان مرتفع وهذا مستحيل سابقا .

تحياتي وتقديري .

  • Like 1
  • Thanks 1
  • 4 weeks later...
m.r

m.r

قام بنشر
قام بنشر

خوية عصام يصير اخلي الكود في قاعدة البيانات لان اذا انحذف الكود اخاف ترجع المشكلة نفسه لو شنو رايك

m.r

m.r

قام بنشر
قام بنشر

هوه الكود لو بالقاعدة كان بعد اقوى بس الموجود جميل لابئس بي عاشت ايدك 

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

خوية عصام اشلون احول المذكرة الى امتداد vbs اشو اخلي اسم وبعدين الامتداد .vbs اشو يقرا اسم ميحول الى امتداد/ المشكلة وين. ؟

أحمد يوسف

أحمد يوسف

قام بنشر
قام بنشر

السلام عليكم-استاذ أمير , الأمر فى غاية البساطة

فقط تقوم بتحديد المكان الذى تريد وضع هذا الكود به وليكن على سطح المكتب لجهاز الكمبيوتر

ثم تقوم بعمل كليك يمين بالماوس ثم تختار New

وبعد ذلك تختار Text Document

وبعد ذلك  سيفتح لك ملف نصى جديد , يكون هكذا 

New Text Document.txt

تقوم بعد ذلك بلصق كود الأستاذ عصام به ,ثم بعد ذلك حفظ وغلق الملف

وبعد غلقه تقوم بتغيير امتداد الملف من .txt الى ما يطلبه منك استاذ عصام اى الى .Vbs

أتمنى ان يكون الأمر قد تبين وتوضح لك الأن

بارك الله فيكم جميعا

 

  • Like 1
m.r

m.r

قام بنشر
قام بنشر

خوية احمد سويت مثل مامطلوب مني بس نفس الشي بعده يضهر الشريط تمكين المحتوى / هذا عملي داخل الفولدر الي بيها القاعدة

bandicam 2019-10-17 21-22-17-880.jpg

bandicam 2019-10-17 21-24-32-810.jpg

أبو عبدالله الحلوانى

أبو عبدالله الحلوانى

قام بنشر
قام بنشر

أستاذ @Amir - 4k   ماذا يحدث عندما تفتح ملف vbs 

هل تظهر لك رسالة خطأ  ولو أمكن تقوم بتصوير رسالة الخطأ 

وياحبذا لو ذكرت لنا نوع الأوفس لديك (2019 - 2016 - 2010 - 2003)

وهل قمت بتغير رقم الاصدار داخل الكود وفقا لتعليمات أستاذنا  @essam rabea 

  • Like 1
m.r

m.r

قام بنشر
قام بنشر (معدل)

استاذ الوندوز مالتي 64 اخاف ياثر لو ماله علاقة/ الاصدار الاوفيس 2010

bandicam 2019-10-17 21-48-16-869.jpg

تم تعديل بواسطه Amir - 4k
توضيح
essam rabea

essam rabea

قام بنشر
  • الكاتب
قام بنشر (معدل)

عدل الكود ليلائم الأوفيس تبعك كالآتى 


	Const HKEY_CURRENT_USER = &H80000001
 
	Dim oRegistry	
	Dim sPath				
	Dim sDescription		
	Dim bAllowSubFolders		
	Dim bAllowNetworkLocations 	
	Dim bAlreadyExists
	Dim sParentKey
	Dim iLocCounter
	Dim arrChildKeys
	Dim sChildKey	
	Dim sValue
	Dim sNewKey

	Set WshShell = CreateObject("WScript.Shell")
	strCurDir = WshShell.CurrentDirectory

	Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
	sPath = strCurDir  	
	sDescription = "YourTrustedLocationDescriptionGoesHere"
	bAllowSubFolders = True
	bAlreadyExists = False

	sParentKey = "Software\Microsoft\Office\14.0\Access\Security\Trusted Locations"
'	sParentKey = "Software\Microsoft\Office\14.0\Excel\Security\Trusted Locations"
'	sParentKey = "Software\Microsoft\Office\14.0\PowerPoint\Security\Trusted Locations"
'	sParentKey = "Software\Microsoft\Office\14.0\Word\Security\Trusted Locations"
	iLocCounter = 0
	oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys
	For Each sChildKey in arrChildKeys
		oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue
 		If sValue = sDescription Then bAlreadyExists = True

		If CInt(Mid(sChildKey, 9)) > iLocCounter Then
        		iLocCounter = CInt(Mid(sChildKey, 9))
	        End If
	Next

	'If bAlreadyExists = False Then
		sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1)

		oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey
		oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath
		oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription

		If bAllowSubFolders Then
			oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1
		End If

ولا تنسى وضع الملف فى نفس مسار قاعدة البيانات

تم تعديل بواسطه essam rabea
  • Thanks 1
m.r

m.r

قام بنشر
قام بنشر

ابو عبد الله عاشت ايدك وصلت الفكرة غيرت رقم الاصدار صار يعمل عندي(.اشكرك ابو عبد الله واشكر اخوية عصام واشكر اخوية احمد يوسف)

  • Like 1
Elsayed Bn Gemy

Elsayed Bn Gemy

قام بنشر
قام بنشر

للاسف لم يعمل معى
 اوفيس 2013   32Bit
ويندوز     8         64bit
قمت بتغيير المسار الى 15.0  ولا كن لا يعمل

هذا الكود المستخدم

  

 Const HKEY_CURRENT_USER = &H80000001
 
    Dim oRegistry    
    Dim sPath    
    Dim sDescription    
    Dim bAllowSubFolders    
    Dim bAllowNetworkLocations    
    Dim bAlreadyExists    
    Dim sParentKey    
    Dim iLocCounter    
    Dim arrChildKeys    
    Dim sChildKey    
    Dim sValue    
    Dim sNewKey    

    Set WshShell = CreateObject("WScript.Shell")
    strCurDir = WshShell.CurrentDirectory

    Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
    sPath = strCurDir 

    sDescription = "YourTrustedLocationDescriptionGoesHere"
    bAllowSubFolders = True
    bAlreadyExists = False

    sParentKey = "Software\Microsoft\Office\15.0\Access\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\15.0\Excel\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\15.0\PowerPoint\Security\Trusted Locations"
'    sParentKey = "Software\Microsoft\Office\15.0\Word\Security\Trusted Locations"
    iLocCounter = 0
    oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys
    For Each sChildKey in arrChildKeys
        oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue
         If sValue = sDescription Then bAlreadyExists = True

        If CInt(Mid(sChildKey, 9)) > iLocCounter Then
                iLocCounter = CInt(Mid(sChildKey, 9))
            End If
    Next

    'If bAlreadyExists = False Then
        sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1)

        oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey
        oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath
        oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription

        If bAllowSubFolders Then
            oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1

        End If

 

essam rabea

essam rabea

قام بنشر
  • الكاتب
قام بنشر

تأكد من أن الملف وقاعدة البيانات فى مسار واحد

تأكد من رقم نسخة الأوفيس 

C:\Program Files (x86)\Microsoft Office\Office16    شوف آخر رقم عند كام

 

essam rabea

essam rabea

قام بنشر
  • الكاتب
قام بنشر

عذرا .. الاسكريبت إشتغل مع كله مش عارف ليه معقر معاك .. طب شوف جهاز تانى يكون عليه ويندوز 7 أو 10 جرب عليه تانى

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept