Vba 更新Access中的Northwind刷新表链接_Vba_Ms Access_Northwind

Vba 更新Access中的Northwind刷新表链接

vba ms-access

Vba 更新Access中的Northwind刷新表链接,vba,ms-access,northwind,Vba,Ms Access,Northwind,有一个数据库程序，我正在工作。出于某种原因，老板购买了所有64位2010办公套件，所以我正在更新程序，以便在64位办公套件上工作在本节中，我遇到了一个问题，即如何在64位访问上实现这一点。我似乎无法得到关于msaof的直接答案，也找不到任何有更新代码的工作。它是Northwind Refresh Table链接的一部分，可以在internet上找到，但代码只能在32位下工作 Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPE

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

在本节中，我遇到了一个问题，即如何在64位访问上实现这一点。我似乎无法得到关于msaof的直接答案，也找不到任何有更新代码的工作。它是Northwind Refresh Table链接的一部分，可以在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.nmaxustrfilter=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

Option Explicit'要求在使用变量之前声明变量。
选项“比较数据库”使用数据库顺序进行字符串比较。
私有将PtrSafe函数GetOpenFileName Lib“comdlg32.dll”别名“GetOpenFileNameA”（pOpenfilename作为OPENFILENAME）声明为布尔值
将PtrSafe函数GetSaveFileName Lib“comdlg32.dll”别名“GetSaveFileNameA”（pOpenfilename作为OPENFILENAME）声明为布尔值
键入MSA_OPENFILENAME
'用于文件打开对话框筛选器的筛选器字符串。
'使用MSA_CreateFilterString（）创建此。
'默认值=所有文件，**
strFilter作为字符串
'要显示的初始筛选器。
'默认值=1。
lngFilterIndex尽可能长
'用于打开对话框的初始目录。
'默认值=当前工作目录。
串
'用于填充对话框的初始文件名。
'默认=''。
作为字符串的strInitialFile
strDialogTitle作为字符串
'如果用户未指定扩展名，则附加到文件的默认扩展名。
'默认值=系统值（打开文件、保存文件）。
strDefaultExtension作为字符串
'要使用的标志（请参见常量列表）。
'默认值=没有标志。
lngFlags和
'已拾取文件的完整路径。在OpenFile上，如果用户选择
'不存在文件，仅返回“文件名”框中的文本。
strfullpaths返回为字符串
'拾取的文件的文件名。
strFileName作为字符串返回
'文件名所在的完整路径（strFullPathReturned）中的偏移量
“（strFileNameReturned）开始。
intFileOffset为整数
'文件扩展名开始的完整路径（strFullPathReturned）中的偏移量。
整数形式的intFileExtension
端型
Const ALLFILES=“所有文件”
键入OPENFILENAME
l结构尺寸与长度相同
hwndOwner作为LongPtr
hInstance As LongPtr
lpstrFilter作为字符串
lpstrCustomFilter作为字符串
nMaxCustFilter尽可能长
n过滤器索引尽可能长
lpstrFile作为字符串
nMaxFile尽可能长
lpstrFileTitle作为字符串
nMaxFileTitle尽可能长
lpstrInitialDir作为字符串
lpstrTitle作为字符串
旗子一样长
nFileOffset为整数
nFileExtension为整数
lpstrDefExt作为字符串
lCustData尽可能长
lpfnHook As LongPtr
lpTemplateName作为字符串
端型
n_ALLOWMULTISELECT的常数=&H200
n_CREATEPROMPT的常数=&H2000
n_EXPLORER的常数=&H80000
n_文件的常量mustexist=&H1000
n_hidereadoly的常数=&H4
n_NOCHANGEDIR=&H8的常数
N_节点参考线常数=&H100000
n_NONETWORKBUTTON的常数=&H20000
N_NOREADONLYRETURN的常数=&H8000
诺瓦利达常数=&H100
n_overwritecompt=&H2的常数
n_路径的常数必须存在=&H800
n_READONLY的常数=&H1
n_SHOWHELP的常数=&H10
函数FindNorthwind（strSearchPath）作为字符串
'显示“打开文件”对话框，供用户查找
“电子数据数据库。返回数据的完整路径。
Dim msaof作为MSA_OPENFILENAME
'设置对话框的选项。
msaof.strDialogTitle=“ElectricData.accdb在哪里？”
msaof.strInitialDir=strearchpath
msaof.strFilter=MSA_CreateFilterString（“数据库”，“**.accdb”）
'调用“打开文件”对话框例程。
MSA_GetOpenFileName msaof
'返回路径和文件名。
FindNorthwind=修剪（msaof.strFullPathReturned）
端函数
函数MSA_CreateFilterString（paramary varFilt（）作为变量）作为字符串
'从传入的参数创建筛选器字符串。
如果未传入任何参数，则“返回”。
'需要偶数个参数（筛选器名称、扩展名），但
'如果传入一个奇数，它会附加**
作为字符串的Dim strFilter
作为整数的Dim intRet
Dim intNum作为整数
intNum=UBound（varFilt）
如果是（intNum-1），那么
对于intRet=0到intNum
strFilter=strFilter&varFilt（intRet）&vbNullChar
下一个
如果intNum Mod 2=0，则
strFilter=strFilter&“***”&vbNullChar
如果结束
strFilter=strFilter&vbNullChar
其他的
strFilter=“”
如果结束
MSA_CreateFilterString=strFilter
端函数
函数MSA_ConverterFilterString（strFilterIn作为字符串）作为字符串
'从条形（“|”）分隔字符串创建筛选器字符串。
'字符串应包含两对筛选器扩展字符串，即“Access Databases |**.accdb | All Files |*.*”
'如果最后一个筛选器对不存在扩展名，则添加*。
'此代码将忽略任何空字符串，即“| |”对。
如果传入的字符串为空，则“返回”。
作为字符串的Dim strFilter
Dim intNum为整数，intPos为整数，intLastPos为整数
strFilter=“”
intNum=0
intPos=1
intLastPos=1
'只要找到条，就添加字符串。
'忽略任何空字符串（不允许）。
做
intPos=InStr（intLastPos，strFilterIn，“|”）
如果（intPos>intLastPos），则
strFilter=strFilter&Mid$（strFilterIn，intLastPos，intPos-intLastPos）&vbNullChar
intNum=intNum+1
intLastPos=intPos+1
ElseIf（intPos=intLastPos）则
intLastPos=intPos+1
如果结束
循环直到（intPos=0）
'如果存在，则获取最后一个字符串（假定strFilterIn未以bar结尾）。
intPos=Len（strFilterIn）
如果（intPos>=intLastPos），则