0
私は6つのテーブルにリンクするアクセスデータベースを持っています。これらのテーブルは毎週更新され、日付の入ったフォルダに保存されます。私は自分のアクセスプログラムが、特にLinked Table Managerを使用してテーブルの場所を選択するようにユーザーに依頼したいと思います。アクセステーブルのリンク
私は6つのテーブルにリンクするアクセスデータベースを持っています。これらのテーブルは毎週更新され、日付の入ったフォルダに保存されます。私は自分のアクセスプログラムが、特にLinked Table Managerを使用してテーブルの場所を選択するようにユーザーに依頼したいと思います。アクセステーブルのリンク
次のコードは、リンク先のデータベースのフルパスとファイル名を入力するように求めます。私は、単にフォルダのプロンプトを表示するのではなく、これを行うことにしました。私は強くあなたがリンクされたテーブルの一つの接続文字列を見て、他のパラメータは「のようなもの以外に指定されていないことを確認してください示唆; DATABASE = C:\ Foldera \ YYMMDD \ MyAccessDB.mdb」
Private Function ReLinkTables()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim tdf2 As DAO.TableDef
Dim strConn As String
Dim strNewPath As String
Dim strTableName As String
On Error GoTo ERROR_HANDLER
' Prompt user for new path...
strNewPath = GetFolder
' Exit if none
If strNewPath = "" Then
Exit Function
End If
Set dbs = CurrentDb
dbs.TableDefs.Refresh
' Find all the linked tables...
For Each tdf In dbs.TableDefs
'Debug.Print tdf.Name & vbTab & tdf.Connect
If Len(tdf.Connect) > 0 Then
strTableName = tdf.Name
Debug.Print "Linked Table: " & tdf.Name & vbTab & tdf.Connect
dbs.TableDefs.Delete strTableName ' Delete the linked table
strConn = ";DATABASE=" & strNewPath
Set tdf2 = CurrentDb.CreateTableDef(strTableName, dbAttachSavePWD, strTableName, strConn)
CurrentDb.TableDefs.Append tdf2
Else ' Not a linked table
'Debug.Print "Keep: " & tdf.Name & vbTab & tdf.Connect
End If
Next tdf
Set tdf = Nothing
Set tdf2 = Nothing
dbs.TableDefs.Refresh
dbs.Close
Set dbs = Nothing
MsgBox "Finished Relinking Tables"
Proc_Exit:
Exit Function
ERROR_HANDLER:
Debug.Print Err.Number & vbTab & Err.Description
Err.Source = "Module_Load_SQLSERVER_DATABASE: ReLinkTables at Line: " & Erl
If Err.Number = 9999 Then
Resume Next
End If
MsgBox Err.Number & vbCrLf & Err.Description
Resume Proc_Exit
Resume Next
End Function
Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
'.InitialFileName = "Z:\xxxxxxxx" ' You can change to valid start path
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
Debug.Print "User selected path: >" & sItem & "<"
If sItem = "" Then MsgBox "User did not select a path.", vbOKOnly, "No Path"
GetFolder = sItem
Set fldr = Nothing
End Function
をありがとう私は試してみます –