أرجو المساعدة في تحويل قاعدة البيانات الي صيغة 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

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

 

[SEMO.Pa3x]

عليكم السلام ماذا تقصد بالاسكربت؟ كيف تريد تمرير كلمة المرور للقاعدة عن طريق ماذا؟

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

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

تحياتي

[SEMO.Pa3x]

أفادك الأخ محمد جزاه الله خيراً.
 

تم تعديل يناير 22, 2021 بواسطه SEMO.Pa3x

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

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

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

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

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

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

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

 

[king5star]

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

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

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

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

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

 

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