اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

أرجو المساعدة في تحويل قاعدة البيانات الي صيغة accde


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

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

أقوم بتحويل قاعدة البيانات الي صيغة accde  باستخدام اسكربت مثل هذا

Call Createadbe

Sub Createadbe()
On Error Resume Next
dim fso
dim mePath

Set fso = CreateObject("Scripting.FileSystemObject")   
mePath = fso.GetAbsolutePathName(".")

Rem here we test if accde file is exist And delete it if it is exist
Rem====================================================================
if fso.FileExists(mePath & "\Write Here Your accde file Name")= True then
	fso.DeleteFile mePath & "\Write Here Your accde file Name"
end if

Rem Here Test if our accdb file is Exist and get started
Rem======================================================
If fso.FileExists(mePath & "\Write Here Your accdb file Name")= True then
	With Createobject("Access.Application")
	.AutomationSecurity = 1
	.SysCmd 603, mePath & "\Write Here Your accdb file Name", mePath & "\Write Here Your accde file Name"
	.Quit
	End With
	MsgBox "Conversion Done Successfully!"
	fso.DeleteFile mePath & "\Write Here Your accdb file Name"
Else
msgbox "Conversion Not Done; Some file Not Exists!"
End If

Rem Now kill My silf:
Rem==================
	if err.number <> 0 then
	    with fso
	         If .FileExists(mePath & "\Write Here Your accdb file Name") then .DeleteFile(mePath & "\Write Here Your accdb file Name")
	         If .FileExists(mePath & "\Database.accdb") then .DeleteFile(mePath & "\Database.accdb")
	         If .FileExists(mePath & "\Database.mdb") then .DeleteFile(mePath & "\Database.mdb")
	         If .FileExists(mePath & "\ConversionAccdbToAccde.vbs") then .DeleteFile(mePath & "\ConversionAccdbToAccde.vbs")	
	    end with	
	end if
End sub

ولكن واجهتني مشكلة أرهقني البحث لها عن حل حتي هذا الوقت. وأرجو من الله أن يوفقكم في ايجاد حل لها 

1- كيف يتم تمرير كلمة المرور للقاعدة المحية بكلمة مرور من خلال الاسكربت؟! 

2- وان كان الحل الأول غير ممكن فيكف أغير كلمة المرور من خلال الاسكربت بعد تحويل قاعدة البيانات الي accde 

وجزاكم الله عني خيرا

رابط هذا التعليق
شارك

كتبت هذا الكود داخل روتين بالأكسس وعمل معي بشكل جيد والحمد لله

Public Sub CangeDBPass(ByVal Dbaz As String, ByVal PSW As String)
Dim wrk As Workspace
Dim dbs As Database

Set wrk = DBEngine.Workspaces(0)
Set dbs = wrk.OpenDatabase(Dbaz, True)

    If Len(PSW & "") > 0 Then
        dbs.NewPassword "", PSW: passDatabase = PSW
    Else
        MsgBox "You don't set password!"
    End If

End Sub

ولكن لست أدري كيف أطوعه ليعمل داخل الاسكربت؟!

 

رابط هذا التعليق
شارك

13 دقائق مضت, SEMO.Pa3x said:

عليكم السلام ماذا تقصد بالاسكربت؟

ملف بامتداد vbs.

vbScript

أضع الكود الأول داخل ملف نصي واحفظه بالامتداد السابق واضعه بجوار قاعدة البيانات لعمل نسخة accde 

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

1- فكان طلبي الأول هل يمكن تمرير كلمة المرور هذه بطريقة ما  من داخل الاسكربت فقد جربت أمر Sendkeys  ولم يفلح الأمر!

2- فكرت أن أبقي الكود الأول علي حاله واضع قاعدة البيانات بدون كلمة مرور ثم بعد انشاء النسخة accde يتم تغير كلمة المرور لها

من خلال كود آخر مثل الكود الثاني. وتم عمل الكود الثاني بنجاح والحمد لله 

ولكن المشكلة التي تواجهني الآن عند ضم الكودين داخل اسكربت واحد فيتم تنفيذ الخطوة الأولي ولما تنتهي اذ بالاسكربت يقفذ للخطوة التالية بدون انتظار تنفيذ الأولي 

فهل من طريقة لجعل الاسكربت ينتظر الانتهاء من انشاء النسخة accde أولا ثم ينتقل لتنفيذ خطوة تغير كلمة المرور!

وجزاكم الله خيرا

 

رابط هذا التعليق
شارك

وهذا شكل الكود الحالي بعد التعديلات الموضحة بالرد السابق

Sub Createadbe()
On Error Resume Next
dim fso
dim mePath

Set fso = CreateObject("Scripting.FileSystemObject")   
mePath = fso.GetAbsolutePathName(".")

if fso.FileExists(mePath & "\Mydb.accde")= True then
	fso.DeleteFile mePath & "\Mydb.accde"
end if

If fso.FileExists(mePath & "\Mydb.accdb")= True then
Dim wrk 
Dim dbs 
	
	rem======here will make accde file from accdb======
	With Createobject("Access.Application")
		.AutomationSecurity = 1
		.SysCmd 603, mePath & "\Mydb.accdb", mePath & "\Mydb.accde"
		.Quit
	End With
	rem=======================================================
	
	rem=====here will add a password to accde file ============
	rem ====put we want check if file is created or not=======	
	rem ===and wait untile create=============================
	
	wscript.sleep(15000)

	if fso.FileExists(mePath & "\Mydb.accde")= True then
		With Createobject("Access.Application")		
			set wrk= .DBEngine.Workspaces(0)	
			set dbs= wrk.OpenDatabase(mePath & "\Mydb.accde", True)	
			dbs.NewPassword "", PSW: passDatabase = "myPassword"
			.Quit
		End With
	else 
		msgbox "the program is not found!" 
	end if	
	rem======end and exit====================================	

	fso.DeleteFile mePath & "\Mydb.accdb"
Else
	msgbox "Some file Not Exists!"
End If

Rem Now kill My silf:
Rem fso.DeleteFile mePath & "\MyVbsName.vbs"

	if err.number = 0 then
	    with fso
	         If .FileExists(mePath & "\Mydb.accdb") then .DeleteFile(mePath & "\Mydb.accdb")
	         If .FileExists(mePath & "\Database.accdb") then .DeleteFile(mePath & "\Database.accdb")
	         If .FileExists(mePath & "\Database.mdb") then .DeleteFile(mePath & "\Database.mdb")
	         If .FileExists(mePath & "\MyvbsName.vbs") then .DeleteFile(mePath & "\MyVbsName.vbs")	
	    End with
	Else 
		msgbox err.number & err.discription	
	End if
End sub

 

رابط هذا التعليق
شارك

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

حياك الله اخي الحبيب ابوعبدالله

الفكرة اخي ابوعبدالله كالتالي

1 -  فتح قاعدة البيانات في وضع الخاص

2 - إزالة كلمة المرور

3 - تحويل قاعدة البيانات من accdb الى accde

4 - تعيين كلمة مرور من جديد لكلتا القاعدتين accdb و accde

هذا الموديل للخطوات 1 ، 2 ، 4

Public Sub Set_Pass(sDBName As String, soLdPass As String, Optional sNewPass As String = "")
    Dim db As DAO.Database
    On Error GoTo Err:
    Set db = OpenDatabase(sDBName, True, False, ";PWD=" & soLdPass)
    db.NewPassword soLdPass, sNewPass
    Exit Sub
Err:
    Resume Next
End Sub

وهذا الكود في زر امر لتنفيذ جميع الخطوات

    Dim app As New Access.Application
    Dim DB_Full_Name As String
    Dim DB_Directory As String
    Dim oLdPass As String, NewPass As String

    oLdPass = 777
'1 And 2
    Set_Pass Me.DB_File, oLdPass, oLdPass
    Set_Pass Me.DB_File, oLdPass, ""

    DB_Full_Name = Me.DB_File
    DB_Directory = Mid(DB_Full_Name, 1, Len(DB_Full_Name) - 6) & ".accde"
     
'3
     app.SysCmd 603, DB_Full_Name, DB_Directory

'4
    oLdPass = ""
    NewPass = 777
    
     Set_Pass Me.DB_File, oLdPass, NewPass
     Set_Pass DB_Directory, oLdPass, NewPass

تحياتي

  • Like 2
رابط هذا التعليق
شارك

في ٢٢‏/١‏/٢٠٢١ at 14:51, محمد أبوعبدالله said:

هذا الموديل للخطوات 1 ، 2 ، 4

جزاكم الله خيرا

كنت أحاول فعل هذا من خارج الأكسس بواسطة اسكربت 

وتمت الفائدة والحمد لله

سأرفق هنا الاسكربت بعد التعديل لتعم الفائدة ان شاء الله 

 

  • Like 2
رابط هذا التعليق
شارك

  • 3 weeks later...
في ٢٤‏/١‏/٢٠٢١ at 21:16, أبو عبدالله الحلوانى said:

جزاكم الله خيرا

كنت أحاول فعل هذا من خارج الأكسس بواسطة اسكربت 

وتمت الفائدة والحمد لله

سأرفق هنا الاسكربت بعد التعديل لتعم الفائدة ان شاء الله 

 

فى انتظار السكربيت وشرحه افادك الله

 

رابط هذا التعليق
شارك

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