ODBC linkリフレッシュ

Private Sub btnGO_Click()
	
	Dim wkTBL As String, wkLEN As String, wkDSN As String
	Dim WKSRCTBL As String, wkUID
	Dim MyTbl As DAO.TableDef
	Dim prp As DAO.Property
	
	For Each MyTbl In CurrentDb.TableDefs
		wkTBL = MyTbl.Name
		WKSRCTBL = MyTbl.SourceTableName
		If MyTbl.Attributes And dbAttachedODBC Then
			wkLEN = InStr(1, MyTbl.Connect, “DSN=") + 4
			wkDSN = Mid(MyTbl.Connect, wkLEN, InStr(wkLEN, MyTbl.Connect, “;") – wkLEN)
			'call link
			AUTO_LINK wkTBL, WKSRCTBL, wkDSN, “userid", “password"
			End If
		End If
	Next
	
	MsgBox “done!"
	Exit Sub
End Sub

Sub AUTO_LINK(dbtable As String, dbname As String, dsn As String, uid As String, pwd As String)
	
	Dim db As Database, TblDef As TableDef
	Dim prp As DAO.Property, flgpw As Boolean
	
	flgpw = True 'save password in link
	On Error Resume Next
	'delete
	DoCmd.DeleteObject acTable, dbtable
	On Error GoTo 0
	Set db = DBEngine.Workspaces(0).Databases(0)
	
	Set TblDef = db.CreateTableDef(dbtable)
	TblDef.Connect = “ODBC;DSN=" & dsn & “;UID=" & uid & “;PWD=" & pwd
	TblDef.SourceTableName = dbname
	If flgpw Then
		TblDef.Attributes = dbAttachSavePWD
	End If
	
	db.TableDefs.Append TblDef
	
	Set prp = TblDef.CreateProperty(“Description", dbText, dsn & “:" & uid)
	TblDef.Properties.Append prp
	TblDef.Properties.Refresh
	TblDef.RefreshLink
End Sub