password

[ابراهیـــم]

با سلام و خسته نباشید محضر اساتید محترم و تشکر از بذل عنایات شما عزیزان به سوالات کاربران این سایت



درخصوص نمونه زیر سوالی داشتم که بعد از ایجاد سال مالی جدید پسورد دیتابیس اصلی برداشته می شود چگونه می شود سال مالی جدید را با نگهداشتن همان پسورد دیتابیس که در اینجا
Source.mdb
نام دارد افتتاح نمود


البته لازم بذکر است این قسمت مربوط به بک آپ گیری از دیتابیس می باشد که از اطلاعات همین سایت برداشته شده است .در همین جا بر خود لازم می دانم از عزیزی که این تکه کد را نوشته بودند تقدیر بعمل آورم.

[amirzazadeh]

با سلام و خسته نباشید محضر اساتید محترم و تشکر از بذل عنایات شما عزیزان به سوالات کاربران این سایت


درخصوص نمونه زیر سوالی داشتم که بعد از ایجاد سال مالی جدید پسورد دیتابیس اصلی برداشته می شود چگونه می شود سال مالی جدید را با نگهداشتن همان پسورد دیتابیس که در اینجا
Source.mdb
نام دارد افتتاح نمود

سلام
كد انتقال رو به اين شكل اصلاح كنيد:

Private Sub TransferDB()
'On Error GoTo TransferDB_Error

Dim wrkDefault As Workspace
Dim dbsNew As Database
Dim path As String
Dim i As Integer, e As Integer

Set wrkDefault = DBEngine.Workspaces(0)
Set AllTableDefs = CurrentDb.TableDefs

backpath = Me.Text1
If Dir(backpath) <> "" Then Kill backpath
'MsgBoxFa ".ãÓíÑ ÇíÌÇÏ ÓÇá ãÇáí ÌÏíϺ ÕÍíÍ äãí ÈÇÔÏ", vbInformation + vbMsgBoxRight, "F:\acc\Data\"

Set dbsNew = wrkDefault.CreateDatabase(backpath, dbLangGeneral, dbEncrypt)
dbsNew.NewPassword "", "123"

'ÈÌÇí Çíä˜å ÈÎæÇåíã ÊãÇã ÌÏÇæá ãæÌæÏ ÇÒ Ìãáå ÌÏÇæá ÓíÓÊãí Ñæ ÕÇÏÑ ˜äíã ÝÞØ ÇæäåÇí ˜å ÇÒ ÞÈá ÏÑ áíÓÊ æÇÑÏ ˜ÑÏíã Ñæ ÕÇÏÑ ãí˜äíã
For i = 0 To Me.List11.ListCount - 1
'ÈÇ Çíä ÏÓÊæÑ ÇÈÊÏÇ í˜ ˜í ÇÒ ÌÏæá ãæÑÏ äÙÑ ÈÇ äÇã ÌÏíÏ ãíÓÇÒíã ÊÇ áíä˜Ô ÇÒ Èíä ÈÑå æ ÇÑÊÈÇØí ÈÇ ÝÇíá ÇÕáí äÏÇÔÊå ÈÇÔå
DoCmd.CopyObject , Me.List11.ItemData(i) & "2", acTable, Me.List11.ItemData(i)

'ÏÑ ÇíäÌÇ åã ÌÏæá ãæÞÊ ÊæáíÏ ÔÏå ÑÇ Èå ÝÇíá Ș  ÕÇÏÑ ãí˜äíã
DoCmd.TransferDatabase acExport, "Microsoft Access", backpath, acTable, Me.List11.ItemData(i) & "2", Me.List11.ItemData(i)
Next

'ÏÑ ÂÎÑíä ãÑÍáå ÌÏÇæá ãæÞÊ ÇíÌÇÏ ÔÏå Ñæ ÇÒ Èíä ãíÈÑíã
For e = 0 To Me.List11.ListCount - 1
DoCmd.DeleteObject acTable, Me.List11.ItemData(e) & "2"
Next

TransferDB_Error:
If err.number = 3211 Or err.number = 2617 Or err.number = 3033 Then
Resume Next
ElseIf err.number = 0 Then
Exit Sub
Else
MsgBox err.number & ": " & err.Description
End If
End Sub

[ابراهیـــم]

سلام امیر جان دست درد نکنه مشکل حل شد
ممنون