Office中国论坛/Access中国论坛

标题: 连接后台数据表问题，怎样连接带密码的后台数据 [打印本页]
作者: huang1314    时间: 2011-5-25 10:47
标题: 连接后台数据表问题，怎样连接带密码的后台数据
我在网上找到的后台连接方法，连后台没有密码的数据库正常，现在想改成可以连接带密码的后台数据，请大家帮改一改。



以下连接函数代码

Public Function CheckLinks() As Boolean
' 检查到后台数据库的链接；如果链接存在且正确的话，返回 True 。
Dim dbs As Database, rst As DAO.Recordset
Set dbs = CurrentDb()
' 打开链接表查看表链接信息是否正确。
On Error Resume Next
Set rst = dbs.OpenRecordset("职务表") '只须查找其中一个表即可
rst.Close
' 如果没有错误，返回 True 。
If Err = 0 Then
CheckLinks = True
Else
CheckLinks = False
End If
End Function

以下是连接窗体的代码


If CheckLinks = False Then '如果后台数据库链接错误,则重新链接后台数据库
                Dim tabDef As TableDef
                Dim FileName
                Dim box As String
               
                FileName = Application.CurrentProject.path & "\home.m__"
                If Dir(FileName) = "" Then
                 box = MsgBox("没找到数据端,请确定本系统已正确安装到你的电脑中", vbAbortRetryIgnore + vbQuestion, "^-^ 提醒!")
                If box = vbIgnore Then
                i = i + 4
                Me.Label14.Caption = "链接数据端失败"
                   Me.Label20.Visible = True
                    Me.Label20.Caption = "×"
                    Me.Label20.ForeColor = 255
                ElseIf box = vbAbort Then
                  DoCmd.Close
                  Else
                    i = i - 79
                End If
                Else
                For Each tabDef In CurrentDb.TableDefs
                If Len(tabDef.Connect) > 0 Then


                  tabDef.Connect = ";DATABASE=" & FileName & ""     
                   我想应该是这个句，怎样改成带密码的？

                tabDef.RefreshLink
                End If
                Next
                Me.Label14.Caption = "链接数据端成功"
                    Me.Label20.Visible = True
                    Me.Label20.Caption = "√"
                End If
                Else
                Me.Label14.Caption = "链接数据端成功"
                    Me.Label20.Visible = True
                    Me.Label20.Caption = "√"
                End If
作者: roych    时间: 2011-5-25 11:22
本帖最后由 roych 于 2011-5-25 11:40 编辑

这是俺根据一个前辈的代码，自己做的重定位链接表，供参考（详细请看代码注释，如果无法执行的话，请重新引用Office库）。
[attach]45676[/attach]
关键在于打开数据库时应该是带密码的，而不是LZ所以为的那样。
dim dbs as dao.database
set dbs = OpenDatabase(Me.Txt_Path.Value, False, False, ";PWD=" & MyPwd)
  1. Private Sub Cmd_LnkTbl_Click()
  2. '定义后台数据库、后台链接表、后台路径以及链接表密码。
  3. Dim dbs As Database
  4. Dim Tdf As TableDef
  5. Dim MyPath As String
  6. Dim MyFile As String
  7. Dim MyPwd As String

  9. '错误处理
  10. On Error GoTo err1
  11. '初始化，表示未链接或者链接失败。
  12. LnkTbl = False
  13. '删除当前数据库的所有链接表。
  14. Set dbs = CurrentDb
  15. For Each Tdf In CurrentDb.TableDefs
  16. If Len(Tdf.Connect) > 0 Then
  17. DoCmd.DeleteObject acTable, Tdf.Name
  18. End If
  19. Next Tdf
  20. dbs.Close
  21. '显示打开对话框以获取后台路径（需要引用Office库才能执行）
  22. Set fd = Application.FileDialog(msoFileDialogFilePicker)
  23. With fd
  24. .Filters.Clear
  25. .Filters.Add "Access数据库(*.mdb)", "*.mdb"
  26. .Title = "请浏览文件"
  27. .ButtonName = "打开"
  28. .InitialView = msoFileDialogViewDetails
  29. If .Show = -1 Then
  30. '获取链接表地址和密码。
  31. Me.Txt_Path.Value = CStr(fd.SelectedItems.Item(1))
  32. '
  33. MyPwd = "后台数据库密码"
  34. '打开带密码的数据库。
  35. Set dbs = OpenDatabase(Me.Txt_Path.Value, False, False, ";PWD=" & MyPwd)
  36. For Each Tdf In dbs.TableDefs
  37. '如果是非隐藏的本地表就链接（隐藏表会包含系统对象表）。
  38. If Len(Tdf.Connect) = 0 And Tdf.Attributes = 0 Then
  39. DoCmd.TransferDatabase acLink, "Microsoft Access", Me.Txt_Path.Value, acTable, Tdf.Name, Tdf.Name, False
  40. End If
  41. Next Tdf
  42. dbs.Close
  43. Set dbs = Nothing
  44. LnkTbl = True
  45. Exit Sub
  46. Else
  47. Debug.Print "用户取消"
  48. End If
  49. End With
  50. err1:
  51. LnkTbl = False
  52. MsgBox Err.Description, vbExclamation, "错误！"
  53. End Sub
复制代码

作者: 鱼儿游游    时间: 2011-5-25 12:49
本帖最后由 鱼儿游游 于 2011-5-25 12:56 编辑

帮你写了一个过程，看看能不能帮到你，LZ。

Sub LinkTable(strMDBFileName As String, strUserName As String, strPassword As String, strSourceTableName As String)
'
' strMDBFileName ...... 后台数据库名（MBD）
' strUserName ......... 打开数据库的用户名
' strPassword ......... 打开数据库的密码
' strSourceTableName ..要建立连接的数据表名（在后台数据库中）
'
' 作者：鱼儿游游
' 时间：2011.05.25
'
   Dim strConnect          As String      '连接字串
   Dim dbs                 As Object      'Database
   Dim tdf                 As Object      'DAO.TableDef
   Dim strLocalTableName   As String      '连接表的名称
   
    '定义连接字串
   strConnect = "MS Access" & _
                 ";DATABASE=" & strMDBFileName & _
                 ";UID=" & strUserName & _
                 ";pWD=" & strPassword
   Set dbs = CurrentDb
   strLocalTableName = strSourceTableName
   '删除原来的链接表
   dbs.TableDefs.Delete strLocalTableName
   '重新创建链接表
   Set tdf = dbs.CreateTableDef(strLocalTableName)
   tdf.Connect = strConnect
   tdf.SourceTableName = strSourceTableName
   dbs.TableDefs.Append tdf
   Set tdf = Nothing
   Set dbs = Nothing
   
End Sub
作者: huang1314    时间: 2011-5-25 15:22
能不能改我的代码
作者: t小宝    时间: 2011-5-25 16:08
本帖最后由 t小宝 于 2011-5-25 16:09 编辑

tabDef.Connect = ";DATABASE=" & FileName & "pWD=" & 密码
作者: roych    时间: 2011-5-25 17:25
t小宝 发表于 2011-5-25 16:08
tabDef.Connect = ";DATABASE=" & FileName & "pWD=" & 密码

貌似PWD前面应该加分号~~
作者: huang1314    时间: 2011-5-25 19:42

tabDef.Connect = ";DATABASE=" & FileName & ";pWD=" & 密码
tabDef.RefreshLink    这句出错



没加密码之前是正常的

tabDef.Connect = ";DATABASE=" & FileName & "“
tabDef.RefreshLink

再帮我看看，谢谢




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3