5

リンクされたテーブルであるかどうかに基づいて、データベース内のすべてのテーブルを再リンクする手順があります。現在、これは、関数を呼び出す AutoExec マクロ内で設定されているため、自動的に実行されるように設定されています。

コードは機能しますが、データベースを閉じて再度開いた場合のみです。これは、新しいリンクを有効にするためにこれを行う必要があるためであることはわかっていますが、とにかくこれについてはありますか? または、それができない場合は、VBA コードでデータベースを閉じてから再度開く方がよいでしょうか?

フィードバックをお寄せいただきありがとうございます

PS興味がある場合は、コードを次に示します。

'*******************************************************************
'*  This module refreshes the links to any linked tables  *
'*******************************************************************


'Procedure to relink tables from the Common Access Database
Public Function RefreshTableLinks() As String

On Error GoTo ErrHandler
    Dim strEnvironment As String
    strEnvironment = GetEnvironment

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef

    Dim strCon As String
    Dim strBackEnd As String
    Dim strMsg As String

    Dim intErrorCount As Integer

    Set db = CurrentDb

    'Loop through the TableDefs Collection.
    For Each tdf In db.TableDefs

            'Verify the table is a linked table.
            If Left$(tdf.Connect, 10) = ";DATABASE=" Then

                'Get the existing Connection String.
                strCon = Nz(tdf.Connect, "")

                'Get the name of the back-end database using String Functions.
                strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1)))

                'Debug.Print strBackEnd

                'Verify we have a value for the back-end
                If Len(strBackEnd & "") > 0 Then

                    'Set a reference to the TableDef Object.
                    Set tdf = db.TableDefs(tdf.Name)

                    If strBackEnd = "\Common Shares_Data.mdb" Or strBackEnd = "\Adverse Events.mdb" Then
                        'Build the new Connection Property Value - below needs to be changed to a constant
                        tdf.Connect = ";DATABASE=" & strEnvironment & strBackEnd
                    Else
                        tdf.Connect = ";DATABASE=" & CurrentProject.Path & strBackEnd

                    End If

                    'Refresh the table links
                    tdf.RefreshLink

                End If

            End If

    Next tdf

ErrHandler:

 If Err.Number <> 0 Then

    'Create a message box with the error number and description
    MsgBox ("Error Number: " & Err.Number & vbCrLf & _
            "Error Description: " & Err.Description & vbCrLf)

End If

End Function

編集

Gords のコメントに続いて、AutoExec以下のコードを呼び出すためのマクロ メソッドを追加しました。誰でもこれに問題がありますか？

Action: RunCode
Function Name: RefreshTableLinks()
4

1 に答える 1

5

この状況で最も一般的なエラーは.RefreshLink、TableDef を忘れていることですが、すでにそうしています。Products_EN.accdb[Products_linked] という名前のリンク テーブルを 2 つの Access バックエンド ファイル(英語) とProducts_FR.accdb(フランス語)間で切り替える次の VBA コードをテストしました。VBA コードを実行してすぐにリンク テーブルを開くと、変更が行われていることがわかります。データベースを閉じて再度開く必要はありません。

Function ToggleLinkTest()
Dim cdb As DAO.Database, tbd As DAO.TableDef
Set cdb = CurrentDb
Set tbd = cdb.TableDefs("Products_linked")
If tbd.Connect Like "*_EN*" Then
    tbd.Connect = Replace(tbd.Connect, "_EN", "_FR", 1, 1, vbBinaryCompare)
Else
    tbd.Connect = Replace(tbd.Connect, "_FR", "_EN", 1, 1, vbBinaryCompare)
End If
tbd.RefreshLink
Set tbd = Nothing
Set cdb = Nothing
End Function

そのコードを AutoExec マクロから呼び出すこともテストしましたが、期待どおりに動作するようです。

あなたが試すことができることの1つdb.TableDefs.Refreshは、ルーチンの最後に電話して、それが役立つかどうかを確認することです.

編集

ここでの問題は、データベースの「アプリケーション オプション」で指定された「表示フォーム」があり、そのフォームがAutoExec マクロが実行される前に自動的に開くように見えることでした。再リンク コードの関数呼び出しを、その "スタートアップ フォーム" の Form_Load イベント ハンドラに移動すると、おそらく修正されるようです。

于 2013-05-07T11:06:43.637 に答える