0

Webを閲覧しているときに、実行時にテーブルをAccessデータベースに動的にリンクできる次の関数を見つけました。

Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean

'************************************************************************************
'* Create an attached table in the current database from a table in a different MDB file.
'* In:                                                                              *
'*   strTable - name of linked table to create                                      *
'*   strPath - path and name of MDB file containing the table                       *
'*   strBaseTable - name of table in strPath MDB                                    *
'* Out:                                                                             *
'*   Return value: True/False, indicating success                                   *
'* Modifies:                                                                        *
'*   Nothing, but adds a new table.                                                 *
'************************************************************************************

On Error GoTo CreateAttachedError

Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database

    DoCmd.SetWarnings False
    Set myDB = CurrentDb
    Set tdf = myDB.CreateTableDef(strTable)

    With tdf
        .Connect = ";DATABASE=" & strPath
        .SourceTableName = strBaseTable
    End With

    myDB.TableDefs.Append tdf

    fRetval = True

    DoCmd.SetWarnings True

CreateAttachedExit:
    createAttached = fRetval
    Exit Function

CreateAttachedError:
    If Err = 3110 Then
        Resume CreateAttachedExit
    Else
        If Err = 3011 Then
            Resume Next
        End If
    End If

End Function

このスクリプトは機能しますが、テーブルがすでにリンクされている場合は、何も実行しません（ただし、エラーイベントは引き続きトリガーされます）。同じスクリプトで、リンクされたテーブルが存在する場合は削除するか、少なくともそのリンクを更新して、パスが正しいものになるようにします。これを行う方法がわかりません。おそらく非常に簡単ですが、どこから始めればよいのかわかりません。

ありがとうございました。

4

1 に答える 1

0

これが私が使っているものです。また、リンクを更新する前に、テーブルがリンクされたテーブルであるかどうかをテストします。このコードは、リンク先のデータベースがリンク元のデータベースと同じフォルダーにあることを前提としています。そうでない場合は、「Application.CurrentProject.Path」を削除し、適切なパスを追加します。

Public Sub RelinkTables()
    Dim dbs As Database
    Dim Tdf As TableDef
    Dim Tdfs As TableDefs
    Set dbs = CurrentDb
    Set Tdfs = dbs.TableDefs
    For Each Tdf In Tdfs
        If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
            Tdf.Connect = ";DATABASE=" & Application.CurrentProject.Path & "\filename.accdb" 'Set the new source
            Tdf.RefreshLink 'Refresh the link
        End If
    Next 'Goto next table
End Sub
于 2012-11-01T15:50:09.510 に答える