Call PassChange(getPath & "DATA.mdb")


'**********************************************************************
'*  リンクテーブルのリンク先変更
'**********************************************************************
Private Sub PassChange(StrPass As String)  ' StrPassは引数です。
On Error GoTo Err_PassChange
    Dim objTabledef As TableDef   'テーブル定義の操作を行うオブジェクトです。
    'ループを用いてリンクの設定が存在する限り、
    'その設定を新しいStrPassに変更していきます。
    For Each objTabledef In CurrentDb.TableDefs
        If Len(objTabledef.Connect) <> 0 Then
            objTabledef.Connect = ";database=" & StrPass
            objTabledef.RefreshLink
        End If
    Next
    CurrentDb.TableDefs.Refresh
Exit_PassChange:
    Exit Sub
Err_PassChange:
    Select Case Err.Number   ' エラー番号を評価します。
        Case 3011
            MsgBox "「" & StrPass & "」が存在しません。" & _
                    Chr(13) & Chr(13) & "パスの変更は行われませんでした。", 16
        Case 3024
            MsgBox "指定されたパスは存在しません。" & _
                    Chr(13) & Chr(13) & "パスの変更は行われませんでした。", 16
        Case 3321
            MsgBox "キャンセルされました。" & Chr(13) & Chr(13) & _
                    "パスの変更は行われていません。", 16
        Case Else
            MsgBox "何か予期せぬエラーが発生しました。この処理を終了します。" & _
                   Chr(13) & "なお、パスの変更は行われていません。" & _
                   Chr(13) & Chr(13) & "エラー番号は、" & Err.Number & "です。", 16
    End Select
    Resume Exit_PassChange
End Sub


'**************************************************************************
'*<名称>
'*    getPath()
'*<機能>
'*    Accessファイルのパスを返す
'*<概要>
'*    Accessファイルのパスを返す関数です
'*<引数>
'*　　なし
'*<戻り値>
'*　　なし
'**************************************************************************
Public Function getPath()

Dim strx As String
Dim stry As String
    
strx = CurrentDb.name  '現在のAccessファイルの所在パス
    
'InStrRev()は、ある文字列の中から指定された文字列を最後の文字位置から検索を開始し、
'最初に見つかった文字位置(先頭からその位置までの文字数) を返す文字列処理関数です。
stry = InStrRev(strx, "\")

'C:\xxxx\yyyy\zzz.mdb --> C:\xxxx\yyyy\ にする。
getPath = Left(strx, stry)
    
End Function