连接后台数据表问题，怎样连接带密码的后台数据

huang1314

我在网上找到的后台连接方法，连后台没有密码的数据库正常，现在想改成可以连接带密码的后台数据，请大家帮改一改。



以下连接函数代码

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

这是俺根据一个前辈的代码，自己做的重定位链接表，供参考（详细请看代码注释，如果无法执行的话，请重新引用Office库）。

关键在于打开数据库时应该是带密码的，而不是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
   
8. 
   
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

复制代码

鱼儿游游

帮你写了一个过程，看看能不能帮到你，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

能不能改我的代码

t小宝

tabDef.Connect = ";DATABASE=" & FileName & "pWD=" & 密码

roych

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

貌似PWD前面应该加分号~~

huang1314

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



没加密码之前是正常的

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

再帮我看看，谢谢