[已解决]连接表刷新问题讨论见21楼

zyz218

密码只能是数字？？？？我把后台设为123456就行了，像上面那样的就不行了，不知为什么！！

[ 本帖最后由 zyz218 于 2007-9-14 15:26 编辑 ]

zyz218

好像对密码的长度有个限制？？？可能是这样的，我猜的，但要求多少个字符以内？？还是其它原因？？

zyz218

这个是可以的，什么都没动，就是后台密码简单了。

zyz218

在链接表链接路径正确的情况下，不需要密码竞然说刷新成功了（后台是有密码的）？？

这个贴子我可能发了很多不正确的看法，抱歉，因为我自已也糊涂了！

[ 本帖最后由 zyz218 于 2007-9-14 16:59 编辑 ]

zyz218

送上经典代码如下：
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                   刷新表链接                                 '
'                                                              '
'    这个模块包含用于刷新到后台数据库表的链接的函数，如果那    '
'    些表可用的话。改写自罗斯文商贸数据库！这可是宝库！        '
'                                                              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'======================================================================
'
'本节程序无须修改，需要修改的程序在后
'
'======================================================================
Option Explicit           ' 要求变量在使用以前明确声
Option Compare Database   ' 字符串比较使用数据库次

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type MSA_OPENFILENAME
    ' 用于打开文件对话框过滤器的过滤字符串。
    ' 使用 MSA_CreateFilterString() 来创建它。
    ' 默认(Default) = 所有文件, *.*
    strFilter As String
    ' 用于显示的初始过滤器。
    ' 默认(Default) = 1
    lngFilterIndex As Long
    ' 对话框所作用的初始目录。
    ' 默认(Default) = 当前工作目录。
    strInitialDir As String
    ' 初始文件名。
    ' 默认(Default) = ""
    strInitialFile As String
    strDialogTitle As String
    ' 默认的文件扩展名，如果用户没有指定一个的话，将使用它。
    ' 默认(Default) = 系统值 (打开文件， 保存文件)。
    strDefaultExtension As String
    ' 所使用的标志 (参看“常量”(Const) 列表)
    ' 默认(Default) = 无标志。
    lngFlags As Long
    ' 所选取文件的完整路径。在打开文件(OpenFile)时，如果用户点取了
    ' 一个不存在的文件，将只返回 "File Name"(文件名)框中的文本。
    strFullPathReturned As String
    ' 所选取文件的文件名。
    strFileNameReturned As String
    ' 文件名(strFileNameReturned)开始位置在完整路径中的偏移。
    intFileOffset As Integer
    '文件扩展名开始位置在完整路径(strFullPathReturned)中的偏移。
    intFileExtension As Integer
End Type
Const ALLFILES = "所有文件"
Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As Long
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function FindFile(strSearchPath, strTitle, strFilterFilename, strFilterExtname) As String
' 显示打开文件对话框让用户定位
' 特定的文件。返回文件的完整路径。
   
    Dim msaof As MSA_OPENFILENAME
   
    ' 给对话框设置选项。
    msaof.strDialogTitle = strTitle
    msaof.strInitialDir = strSearchPath
    msaof.strFilter = MSA_CreateFilterString(strFilterFilename, strFilterExtname)
   
    ' 调用打开文件对话框例程。
    MSA_GetOpenFileName msaof
   
    ' 返回路径和文件名。
    FindFile = Trim(msaof.strFullPathReturned)
   
End Function


Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' 从所传递的实参中创建一个过滤器字符串。
' 如果没有传递进任何实参，将返回 "" 。
' 期望传进偶数个实参(过滤字符串、扩展名)， 但
' 如果传进奇数个，将附加 *.* 。  
    Dim strFilter As String
    Dim intRet As Integer
    Dim intNum As Integer

    intNum = UBound(varFilt)
    If (intNum <> -1) Then
        For intRet = 0 To intNum
            strFilter = strFilter & varFilt(intRet) & vbNullChar
        Next
        If intNum Mod 2 = 0 Then
            strFilter = strFilter & "*.*" & vbNullChar
        End If
        
        strFilter = strFilter & vbNullChar
    Else
        strFilter = ""
    End If

    MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
' 从一个竖条分隔的字符串创建一个过滤字符串。
' 该字符串应具有(过滤名称|扩展名)对，例如，"Access 数据库|*.mdb|所有文件|*.*"
' 如果最后一个过滤对没有扩展名，将加上 *.* 。
' 这里代码将忽略任何空字符串，例如， "||" 对。
' 如果传进的字符串是空的，就返回 "" 。

   
    Dim strFilter As String
    Dim intNum As Integer, intPos As Integer, intLastPos As Integer

    strFilter = ""
    intNum = 0
    intPos = 1
    intLastPos = 1

    ' 一旦我们找到竖条，就加入字符串。
    ' 忽略任何空字符串(不允许空字符串)。
    Do
        intPos = InStr(intLastPos, strFilterIn, "|")
        If (intPos > intLastPos) Then
            strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
            intNum = intNum + 1
            intLastPos = intPos + 1
        ElseIf (intPos = intLastPos) Then
            intLastPos = intPos + 1
        End If
    Loop Until (intPos = 0)
        
    ' 获取最后一个子串(假定串 strFilterIn 不以竖条 | 结尾)。
    intPos = Len(strFilterIn)
    If (intPos >= intLastPos) Then
        strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
        intNum = intNum + 1
    End If
   
    ' 如果最后一个子串没有扩展名，那么添加 *.* 。
    If intNum Mod 2 = 1 Then
        strFilter = strFilter & "*.*" & vbNullChar
    End If
   
    ' 如果存在任何过滤字符串，添加空结尾字符 vbNullChar 。
    If strFilter <> "" Then
        strFilter = strFilter & vbNullChar
    End If
   
    MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' 打开保存文件对话框。
   
    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_to_OF msaof, of
    of.Flags = of.Flags Or OFN_HIDEREADONLY
    intRet = GetSaveFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
' 用默认值打开保存文件对话框。

    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String
   
    intRet = MSA_GetSaveFileName(msaof)
    If intRet Then
        strRet = msaof.strFullPathReturned
    End If
   
    MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
' 打开 打开文件对话框。
   
    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_to_OF msaof, of
    intRet = GetOpenFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetOpenFileName = intRet
End Function

Function MSA_SimpleGetOpenFileName() As String
' 用默认值打开打开文件对话框。

    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String
   
    intRet = MSA_GetOpenFileName(msaof)
    If intRet Then
        strRet = msaof.strFullPathReturned
    End If
   
    MSA_SimpleGetOpenFileName = strRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' 这一个子过程将 win32 结构转换到友好的 MSAccess 结构。
   
    msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
    msaof.strFileNameReturned = of.lpstrFileTitle
    msaof.intFileOffset = of.nFileOffset
    msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' 这一个子过程将友好的 MSAccess 结构转换到 win32 结构。
   
    Dim strFile As String * 512

    ' 初始化该结构的某些部分。
    of.hwndOwner = Application.hWndAccessApp
    of.hInstance = 0
    of.lpstrCustomFilter = 0
    of.nMaxCustrFilter = 0
    of.lpfnHook = 0
    of.lpTemplateName = 0
    of.lCustrData = 0
   
    If msaof.strFilter = "" Then
        of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
    Else
        of.lpstrFilter = msaof.strFilter
    End If
    of.nFilterIndex = msaof.lngFilterIndex
   
    of.lpstrFile = msaof.strInitialFile _
        & String(512 - Len(msaof.strInitialFile), 0)
    of.nMaxFile = 511

    of.lpstrFileTitle = String(512, 0)
    of.nMaxFileTitle = 511

    of.lpstrTitle = msaof.strDialogTitle

    of.lpstrInitialDir = msaof.strInitialDir
   
    of.lpstrDefExt = msaof.strDefaultExtension

    of.Flags = msaof.lngFlags
   
    of.lStructSize = Len(of)
End Sub

zyz218

'=================================================================================
'
'需要修改的程序在下
'
'=================================================================================
Public Function CheckLinks() As Boolean
' 检查到后台数据库的链接；如果链接存在且正确的话，返回 True 。
   
    Dim dbs As Database, rst As Recordset
   
    Set dbs = CurrentDb

    ' 打开链接表查看表链接信息是否正确。
    On Error Resume Next
    Set rst = dbs.OpenRecordset("Blank")
   
    '===============================================
    '"培训项目"表是我的实例数据库中的表，你应该改成
    '自己后台数据库的链接表名。
    '===============================================
    rst.Close

    ' 如果没有错误，返回 True 。
    If Err = 0 Then
        CheckLinks = True
    Else
        CheckLinks = False
    End If
   
End Function

Private Function RefreshLinks(strfilename As String) As Boolean
' 刷新到提供表的数据库的链接。如果成功的话返回 True 。

    Dim dbs As Database
    Dim tdf As TableDef

    ' 循环处理此数据库的所有表。
    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
        ' 如果表有一个连接串，那么该表是一个链接表。
        If Len(tdf.Connect) > 0 Then
            tdf.Connect = ";DATABASE=" & strfilename & "WD=qwofikdfmcs196"
            '==============================================================
            '86123555是我的实例后台数据库的密码，你应该改成自己后台数据
            '的密码。
            '==============================================================
            Err = 0
            On Error Resume Next
            tdf.RefreshLink         ' 重新链接该表。
            If Err <> 0 Then
                RefreshLinks = False
                Exit Function
            End If
        End If
    Next tdf

    RefreshLinks = True        ' 完成重链接。
   
End Function

Public Function RelinkTables() As Boolean
' 尝试刷新连到“后台数据库”数据库的链接。
' 如果成功，返回 True 。

    Dim strfilename As String
    Dim intError As Integer
    Dim strError As String
    Dim BackDataDir As String
   
    Const conMaxTables = 8
    Const conNonExistentTable = 3011
    Const conNotNorthwind = 3078
    Const conNwindNotFound = 3024
    Const conAccessDenied = 3051
    Const conReadOnlyDatabase = 3027
   
    '===========================================
    '你需要修改这里的前后台数据库名称
    '
    Const conAppTitle = "HR.mdb"
    Const conBackAppTitle = "hrdata.mdb"
    '以下不用改
    '===========================================
   
   
    '在注册表中读取“后台数据库”的位置
    BackDataDir = GetSetting(conAppTitle, conAppTitle, "BackDataDir", "")
    If (Dir(BackDataDir & conBackAppTitle) <> "") Then
        strfilename = BackDataDir & conBackAppTitle
    Else
        ' 不能找到“后台数据库”，所以显示打开文件对话框。
        MsgBox "不能找到“" + conBackAppTitle + "”数据库中的链接表。您必须定位“" + _
        conBackAppTitle + "”数据库以便能使用“" _
        & conAppTitle & "”数据库程序。", vbExclamation
        strfilename = FindFile("C:\", "查找 " + conBackAppTitle, "Microsoft Access 数据库", "*.mdb;*.mde")
        If Dir(strfilename) = conBackAppTitle Then
            BackDataDir = Left(strfilename, Len(strfilename) - Len(conBackAppTitle))
            SaveSetting conAppTitle, conAppTitle, "BackDataDir", BackDataDir
        Else
            strError = "抱歉， 您必须定位“" + conBackAppTitle + "”数据库以打开“" & conAppTitle & "”数据库程序。"
            GoTo Exit_Failed
            
        End If
    End If

    ' 修复链接。
    If RefreshLinks(strfilename) Then
        RelinkTables = True
        Exit Function
    End If
   
    ' 如果失败， 显示一个错误消息。
    Select Case Err
    Case conNonExistentTable, conNotNorthwind
        strError = "文件 '" & strfilename & "' 不包含所要求的数据库表。"
    Case Err = conNwindNotFound
        strError = "直到您定位了“" + conBackAppTitle + ".mdb”数据库，您不能运行本“" & conAppTitle & "”程序。"
    Case Err = conAccessDenied
        strError = "因为 " & strfilename & " 是只读的或只读共享的，您不能打开它。"
    Case Err = conReadOnlyDatabase
        strError = "因为 " & conAppTitle & " 是只读的或只读共享的，您不能重新链接表。"
    Case Else
        strError = Err.Description
    End Select
   
Exit_Failed:
    MsgBox strError, vbCritical
    RelinkTables = False
   
End Function
启动窗口打开时
Private Sub Form_Open(Cancel As Integer)
    If CheckLinks() = False Then
        If RelinkTables() = False Then
            DoCmd.Quit
        End If
    End If
End Sub

zyz218

为了这个搞了一天，在此谢谢fan0217,cuxun,andymark等关注兄弟，现在我将自已最终选择的方式以附件方式上传上来,其中的模块来自本论坛ACCESS200问这本书中，确定刷新这个按钮函数来自cuxun的帮助,在此一并感谢！做刷新链接表那个窗体的原因是当我们将前台在本地计算机上改好后要COPY到服务器上并履盖以前的前台，然后要按SHIFT打开它用链接表管理器重新链接到服务器的那个后台，这样很不方便，现在不用按SHIFT打开了，直接打开确定刷新一下，所有人就可以访问了。呵呵！那个刷新的模块很重要，别删了，你感觉它好像可有可无，但一旦你改变了后台密码后，没它好像连不上去了！？只有打开模块运行一下最后那个函数才呢！

[ 本帖最后由 zyz218 于 2007-9-14 20:25 编辑 ]

hauting

受益非浅           

a30088

多谢分享 多谢分享 多谢分享

插班生

:kiss: