在 Access 中更新罗斯文刷新表链接

Posted 2023-04-19

技术标签:

【中文标题】在 Access 中更新罗斯文刷新表链接【英文标题】：Updating the Northwind Refresh Table Links in Access 【发布时间】：2013-03-20 21:32:10 【问题描述】：

我正在开发这个数据库程序。出于某种原因，老板购买了所有 64 位 2010 Office 套件，所以我正在更新程序以在 64 位 Office 上工作。

在本节中，我在尝试找出在 64 位访问上使其工作的方法时遇到了问题。我似乎无法得到关于 msaof 的直接答案，也找不到任何具有更新代码的工作。它是 Northwind Refresh Table Link 的一部分，可以在 Internet 上找到，但代码仅适用于 32 位。

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the friendly MSAccess structure to the win32 structure.

Dim strFile As String * 512

' Initialize some parts of the structure.
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)

结束子

其中一件事是我收到错误“of.nMaxCustrFilter = 0”不存在，但是当我将其注释掉时，调试器仍然指向它并突出显示整个第一行。

更新：这是完整的代码

Option Explicit           ' Require variables to be declared before being used.
Option Compare Database   ' Use database order for string comparisons.


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


Type MSA_OPENFILENAME
    ' Filter string used for the File Open dialog filters.
    ' Use MSA_CreateFilterString() to create this.
    ' Default = All Files, *.*
    strFilter As String
    ' Initial Filter to display.
    ' Default = 1.
    lngFilterIndex As Long
    ' Initial directory for the dialog to open in.
    ' Default = Current working directory.
    strInitialDir As String
    ' Initial file name to populate the dialog with.
    ' Default = "".
    strInitialFile As String
    strDialogTitle As String
    ' Default extension to append to file if user didn't specify one.
    ' Default = System Values (Open File, Save File).
    strDefaultExtension As String
    ' Flags (see constant list) to be used.
    ' Default = no flags.
    lngFlags As Long
    ' Full path of file picked.  On OpenFile, if the user picks a
    ' nonexistent file, only the text in the "File Name" box is returned.
    strFullPathReturned As String
    ' File name of file picked.
    strFileNameReturned As String
    ' Offset in full path (strFullPathReturned) where the file name
    ' (strFileNameReturned) begins.
    intFileOffset As Integer
    ' Offset in full path (strFullPathReturned) where the file extension begins.
    intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
  lStructSize As Long
  hwndOwner As LongPtr
  hInstance As LongPtr
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter 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
  lCustData As Long
  lpfnHook As LongPtr
  lpTemplateName As String
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 FindNorthwind(strSearchPath) As String
' Displays the open file dialog box for the user to locate
' the ElectricData database. Returns the full path to ElectricData.

    Dim msaof As MSA_OPENFILENAME

    ' Set options for the dialog box.
    msaof.strDialogTitle = "Where Is ElectricData.accdb?"
    msaof.strInitialDir = strSearchPath
    msaof.strFilter = MSA_CreateFilterString("Databases", "**.accdb")

    ' Call the Open File dialog routine.
    MSA_GetOpenFileName msaof

    ' Return the path and file name.
    FindNorthwind = Trim(msaof.strFullPathReturned)

End Function


Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Creates a filter string from the passed in arguments.
' Returns "" if no args are passed in.
' Expects an even number of args (filter name, extension), but
' if an odd number is passed in, it appends *.*

    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
' Creates a filter string from a bar ("|") separated string.
' The string should pairs of filter|extension strings, i.e. "Access Databases|**.accdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the strings passed in is empty.

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

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

    ' Add strings as long as we find bars.
    ' Ignore any empty strings (not allowed).
    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)

    ' Get last string if it exists (assuming strFilterIn was not bar terminated).
    intPos = Len(strFilterIn)
    If (intPos >= intLastPos) Then
        strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
        intNum = intNum + 1
    End If

    ' Add *.* if there's no extension for the last string.
    If intNum Mod 2 = 1 Then
        strFilter = strFilter & "*.*" & vbNullChar
    End If

    ' Add terminating NULL if we have any filter.
    If strFilter <> "" Then
        strFilter = strFilter & vbNullChar
    End If

    MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file save dialog.

    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
' Opens the file save dialog with default values.
    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
' Opens the file open dialog.

    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
' Opens the file open dialog with default values.

    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

Public Function CheckLinks() As Boolean
' Check links to the ElectricData database; returns true if links are OK.

    Dim dbs As Database, rst As DAO.Recordset

    Set dbs = CurrentDb()

    ' Open linked table to see if connection information is correct.
    On Error Resume Next
    Set rst = dbs.OpenRecordset("lstPartClasses")

    ' If there's no error, return True.
    If Err = 0 Then
        CheckLinks = True
    Else
        CheckLinks = False
    End If

End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' This sub converts from the win32 structure to the friendly MSAccess structure.

    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)
' This sub converts from the friendly MSAccess structure to the win32 structure.

    Dim strFile As String * 512

    ' Initialize some parts of the structure.
    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

Private Function RefreshLinks(strFilename As String) As Boolean
' Refresh links to the supplied database. Return True if successful.

    Dim dbs As Database
    Dim intCount As Integer
    Dim tdf As TableDef

    ' Loop through all tables in the database.
    Set dbs = CurrentDb
    For intCount = 0 To dbs.TableDefs.Count - 1
        Set tdf = dbs.TableDefs(intCount)

        ' If the table has a connect string, it's a linked table.
        If Len(tdf.Connect) > 0 Then
            tdf.Connect = ";DATABASE=" & strFilename

          '  Debug.Print tdf.Connect
           ' Debug.Print tdf.SourceTableName

            Err = 0
            On Error Resume Next
            tdf.RefreshLink         ' Relink the table.
            If Err <> 0 Then
                RefreshLinks = False
                Exit Function
            End If
        End If
    Next intCount

    RefreshLinks = True        ' Relinking complete.

End Function

Public Function RelinkTables() As Boolean
' Tries to refresh the links to the American Campus IT Department database.
' Returns True if successful.

    Const conMaxTables = 8
    Const conNonExistentTable = 3011
    Const conNotNorthwind = 3078
    Const conNwindNotFound = 3024
    Const conAccessDenied = 3051
    Const conReadOnlyDatabase = 3027
    Const conAppTitle = "Calvin's Electric - Bid/Job Program"

    Dim strAccDir As String
    Dim strSearchPath As String
    Dim strFilename As String
    Dim intError As Integer
    Dim strError As String

    ' Get name of directory where Msaccess.exe is located.
    strAccDir = SysCmd(acSysCmdAccessDir)

    ' Get the default sample database path.
    If Dir(strAccDir & "\.") = "" Then
        strSearchPath = strAccDir
    Else
        strSearchPath = strAccDir & "\"
    End If

    ' Look for the ElectricData database.
    If (Dir(strSearchPath & "ElectricData.accdb") <> "") Then
        strFilename = strSearchPath & "ElectricData.accdb"
    Else
        ' Can't find ElectricData, so display the File Open dialog.
        MsgBox "Can't find linked tables in the Calvin's Electric Bid And Job Program. You must locate the ElectricData Database in order to use " _
            & conAppTitle & ".", vbExclamation
        strFilename = FindNorthwind(strSearchPath)
        If strFilename = "" Then
            strError = "Sorry, you must locate ElectricData.accdb to open " & conAppTitle & "."
            GoTo Exit_Failed
        End If
    End If

    ' Fix the links.
    If RefreshLinks(strFilename) Then   ' It worked!
        RelinkTables = True
        Exit Function
    End If

    ' If it failed, display an error.
    Select Case Err
    Case conNonExistentTable, conNotNorthwind
        strError = "File '" & strFilename & "' does not contain the required ElectricData tables."
    Case Err = conNwindNotFound
        strError = "You can't run " & conAppTitle & " until you locate the ElectricData database."
    Case Err = conAccessDenied
        strError = "Couldn't open " & strFilename & " because it is read-only or located on a read-only share."
    Case Err = conReadOnlyDatabase
        strError = "Can't reattach tables because " & conAppTitle & " is read-only or is located on a read-only share."
    Case Else
        strError = Err.Description
    End Select

Exit_Failed:
    MsgBox strError, vbCritical
    RelinkTables = False

End Function

【问题讨论】：

【参考方案1】：

除了搞乱 32/64 位 API 声明之外，您还可以使用 Access 2010 中提供的 Application.FileDialog 方法。它适用于 32 位和 64 位版本的 Access .

【讨论】：

这是你的 MVP 参考 ***.com/questions/4746938/… 也是 ***.com/questions/1091484/… 您应该真正追求Application.FileDialog 方法，而不是像这样搞乱DLL API。您能否扩展您在尝试此操作时遇到的错误的解释。回复：“我收到错误外部引用无效。” - 在 VBA 中，使用Tools > References... 添加对“Microsoft Office 14.0 对象库”的引用。（或者，你可以使用后期绑定。我最近在这个网站上看到了一些关于如何做到这一点的参考资料。）【参考方案2】：

您似乎有Declare Function 某处需要阅读Declare PtrSafe Function。然后你必须确保你有一个 64 位库用于你正在调用的 DLL。似乎（未经过充分测试）使用此处的代码 http://www.dbforums.com/microsoft-access/990945-building-database-help.html 在我的 64 位应用程序中工作正常。

【讨论】：

我已经在发布之前编辑了声明函数。我会检查一下，因为这是最接近我所在的地方。我对比了两个文件，发现有细微的差别。引用的那个没有 PtrSafe 功能，所以我不确定我想按原样使用它。我会尝试上传整个模块，以便我回家后查看。

以上是关于在 Access 中更新罗斯文刷新表链接的主要内容，如果未能解决你的问题，请参考以下文章

PHP取微信access_token并全局存储与更新

如何使用 Access VBA 更新所有 ODBC 链接的 SQL Server 表的服务器名称

如果 Access 与 MySQL 数据库服务器断开连接，如何刷新链接表？

PHP 定时任务获取微信 access_token

SQL 中的 UNION 和UNION ALL 有啥区别？