بکاپ از پایگاه داده SQL توسط اکسس (VBA)

[ARData]

سلام کاربران محترم
با توجه به نبود کد یا برنامه مشخصی برای بکآپ دیتابیس های SQL در این سایت بر آن شدم تا در خدمت عزیزان سایت باشم :
برای شروع کار ما نیاز به یک کامپوننت (SQLDMO.RLL) و رجیستر کردن آن در سیستم خود می باشیم سپس از طریق کد نویسی زیر دیتابیس مورد نظر را در مسیر دلخواه و با نام دلخواه می توانیم ذخیره نماییم :
جهت رجیستر کردن کامپوننت در پنجره RUN ویندوز عبارت regsvr32 /s- sqldmo.rll را وارد نمایید :
Private Sub Command3_Click()
On Error Resume Next
Dim nIndex As Long
Dim obu As SQLDMO.Backup2
Dim odb As SQLDMO.Database2
Dim odbs As SQLDMO.Databases
Dim ors As SQLDMO.RegisteredServer
Dim orss As SQLDMO.RegisteredServers
Dim osvr As SQLDMO.SQLServer2

'ارتباط با سرور
Set orss = SQLDMO.ServerGroups(1).RegisteredServers
Set ors = orss.Item(1)
Set osvr = New SQLDMO.SQLServer2
osvr.Login = "نام کاربري اس کيو ال"
osvr.LoginTimeout = 5
osvr.Name = ors.Name
osvr.Password = "پسورد اس کيو ال"

'ارتباط و گرفتن ديتابيس مورد نظر
On Error GoTo ConnectSecure
osvr.Connect
On Error GoTo 0
Set odbs = osvr.Databases
For nIndex = 1 To odbs.Count
Set odb = odbs.Item(nIndex)
If odb.Name = "نام ديتابيس مورد نظر" Then
Exit For
End If
Next nIndex
If Not odb.Name = "نام ديتابيس مورد نظر" Then
MsgBox "خطاي ارتباط با ديتابيس."
Exit Sub
End If

Set obu = New SQLDMO.Backup2
obu.Database = "نام ديتابيس مورد نظر"
obu.Files = "D:\نام ديتابيس مورد نظر" & ".bak"
obu.Action = SQLDMOBackup_Database
Call obu.SQLBackup(osvr)

Exit Sub
ConnectSecure:
If osvr.LoginSecure = False Then
MsgBox "خطاي اتصال به سرور مورد نظر."
Else
Set osvr = New SQLDMO.SQLServer2
osvr.LoginSecure = True
osvr.Name = ors.Name
Resume
End If
Exit Sub
End Sub

[ARData]

کد خلاصه شده و دارای قابلیت درج مشخصات سرور نیز طبق کد زیر می باشد :
Private Sub Command3_Click()
On Error Resume Next

Dim nIndex As Long
Dim obu As SQLDMO.Backup2
Dim odb As SQLDMO.Database2
Dim odbs As SQLDMO.Databases
Dim ors As SQLDMO.RegisteredServer
Dim osvr As SQLDMO.SQLServer2
Set osvr = New SQLDMO.SQLServer2
osvr.LoginTimeout = 5

On Error GoTo ConnectSecure
osvr.Connect "نام سرور يا سيستمي که SQL در آن نصب شده است", "نام کاربري SQL", "رمز SQL"

On Error GoTo 0
Set odbs = osvr.Databases
For nIndex = 1 To odbs.Count
Set odb = odbs.Item(nIndex)
If odb.Name = "نام ديتابيس مورد نظر" Then
Exit For
End If
Next nIndex
If Not odb.Name = "نام ديتابيس مورد نظر" Then
MsgBox "خطاي ارتباط با ديتابيس."
Exit Sub
End If

Set obu = New SQLDMO.Backup2
obu.Database = "نام ديتابيس مورد نظر"
'در صورتي که آدرس محل ذخير فايل بکآپ در سيستم سرور غير از سيستم جاري باشد ، فايل در محل آدرس همان سيستم ذخيره خواهد شد
obu.Files = "D:\نام ديتابيس مورد نظر" & ".bak"
obu.Action = SQLDMOBackup_Database
Call obu.SQLBackup(osvr)

Exit Sub
ConnectSecure:
If osvr.LoginSecure = False Then
MsgBox "خطاي اتصال به سرور مورد نظر."
Else
Set osvr = New SQLDMO.SQLServer2
osvr.LoginSecure = True
osvr.Name = ors.Name
Resume
End If
Exit Sub
End Sub

[ARData]

Restore دیتابیس SQL :
Private Sub Command9_Click()
On Error Resume Next
Dim objServer As Object
Dim objRestore As New SQLDMO.Restore
Set objServer = CreateObject("SQLDMO.SQLServer")
objRestore.Database = "نام دلخواه فايلي که قصد ايجاد آن را در ديتابيس SQL داريد"
objRestore.Files = "D:\sss ادرس فايل مثلا :" & ".bak"
objServer.Connect "نام سرور", "نام کاربري", "پسورد"
objRestore.Action = SQLDMORestore_Database
objRestore.ReplaceDatabase = True
objRestore.SQLRestore objServer
End Sub

[royasaz_bam]

با سلام و ممنون
من فایل ارسالی رو داخل درایو E کپی کردم سپس دستور ریجیستر کردن به این صورت زدم regsvr32 /s- E:\sqldmo.rll
ولی فکر نکنم موفق به ریجیستر کردنش شده باشم
درخواست ارسال دستور صحیح با فرض اینکه این اکتیوکس داخل درایو E میباشد دارم و اگر امکان داره یه فایل اجرایی برای ریجیستر کردن این اکتیوکس ارائه بدید
با تشکر

[ARData]

C:\Windows\System32

[royasaz_bam]

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

ولی با این خطا مواجه میشم
120175
حال من نمونه کد که مشخصات دیتا بیس اسکیو ال جایگزین کردم خدمتتون میفرستم مشاهده فرمایید ایراد کجای کار هست
با این توضیحات که نام
دیتا بیس من در سرور اس کیو ال planning
آدرس و نام کاربری و رمز عبور به شرح ذیل میباشد که جایگزین کردم
آدرس سرور= 192.168.100.103
نام کاربری= plan
پسورد = planning@
نام دیتا بیس اسکیوال مورد نظر= planning

مقصد و نام فایل بک آپ = D:\planning



On Error Resume Next

Dim nIndex As Long
Dim obu As SQLDMO.Backup2
Dim odb As SQLDMO.Database2
Dim odbs As SQLDMO.Databases
Dim ors As SQLDMO.RegisteredServer
Dim osvr As SQLDMO.SQLServer2
Set osvr = New SQLDMO.SQLServer2
osvr.LoginTimeout = 5

On Error GoTo ConnectSecure
osvr.Connect "192.168.100.103", "plan", "planning@"

On Error GoTo 0
Set odbs = osvr.Databases
For nIndex = 1 To odbs.Count
Set odb = odbs.Item(nIndex)
If odb.Name = "Planning" Then
Exit For
End If
Next nIndex
If Not odb.Name = "Planning" Then
MsgBox "ÎØÇí ÇÑÊÈÇØ ÈÇ ÏíÊÇÈíÓ."
Exit Sub
End If

Set obu = New SQLDMO.Backup2
obu.Database = "Planning"
'ÏÑ ÕæÑÊí ˜å ÂÏÑÓ ãÍá ÐÎíÑ ÝÇíá Ș ÏÑ ÓíÓÊã ÓÑæÑ ÛíÑ ÇÒ ÓíÓÊã ÌÇÑí ÈÇÔÏ ¡ ÝÇíá ÏÑ ãÍá ÂÏÑÓ åãÇä ÓíÓÊã ÐÎíÑå ÎæÇåÏ ÔÏ
obu.Files = "D:\planning" & ".bak"
obu.Action = SQLDMOBackup_Database
Call obu.SQLBackup(osvr)

Exit Sub
ConnectSecure:
If osvr.LoginSecure = False Then
MsgBox "ÎØÇí ÇÊÕÇá Èå ÓÑæÑ ãæÑÏ äÙÑ."
Else
Set osvr = New SQLDMO.SQLServer2
osvr.LoginSecure = True
osvr.Name = ors.Name
Resume
End If
Exit Sub

[ARData]

با عرض پوزش به دلیل پاسخ با تاخیر :
با توجه به اطلاعات شما ظاهرا هیچ مشکلی وجود ندارد ولی احتمالا اگر از نام کاربری sa استفاده نمایید جواب خواهید گرفت یا نام کاربری sa را در SQL فعال نمایید آدرس محل ذخیر فایل نیز نباید دارای نام فولدرهای جدا از هم یا دارای Space باشند مثل : D:\New Folder 1\File Folder همان خطایی را خواهد داد که شما به آن بر خوردید مسیر دایرکتوری را به صورت زیر اصلاح نمایید : D:\New_Folder_1\File_Folder


(http://barnamenevis.org/member.php?191467-royasaz_bam)