Sub OO4O()
	'ODBCリンクを新アカウントでリフレッシュする
	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

	If IsNull(Me.txtID.Value) Or IsNull(Me.txtPASS.Value) Then
		MsgBox “ID/パスワードをセットしてください"
		Exit Sub
	End If

	For Each MyTbl In CurrentDb.TableDefs
		wkTBL = MyTbl.Name
		WKSRCTBL = MyTbl.SourceTableName
		'ODBC link?
		If MyTbl.Attributes And dbAttachedODBC Then
			'DSN CHECK
			wkLEN = InStr(1, MyTbl.Connect, “DSN=") + 4
			wkDSN = Mid(MyTbl.Connect, wkLEN, InStr(wkLEN, MyTbl.Connect, “;") – wkLEN)
			'USER CHECK
			wkLEN = InStr(1, MyTbl.Connect, “UID=") + 4
			wkUID = UCase(Mid(MyTbl.Connect, wkLEN, InStr(wkLEN, MyTbl.Connect, “;") – wkLEN))

			'DSN MATCH and USER ID match?
			If wkDSN = txtDSN.Value And ((wkUID = UCase(Me.txtID.Value) And _
				chkUID.Value = True) Or chkUID.Value = False) Then
				'SUB link
				AUTO_LINK wkTBL, WKSRCTBL, wkDSN, Me.txtID.Value, Me.txtPASS.Value, Me.chkPW
			End If
		End If
	Next
	'
	MsgBox “done!"
End Sub

Sub AUTO_LINK(dbtable As String, dbname As String, _
	dsn As String, uid As String, pwd As String, flgpw As Boolean)
	'current table name, source table name, DSN,UID,PWD,SAVE password
	Dim db As Database, TblDef As TableDef
	Dim prp As DAO.Property

	On Error Resume Next
	'Delete current link
	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
	'include password
	If flgpw Then TblDef.Attributes = dbAttachSavePWD
	'make link
	db.TableDefs.Append TblDef
	'set link account in memo field
	Set prp = TblDef.CreateProperty(“Description", dbText, dsn & “:" & uid)
	TblDef.Properties.Append prp
	TblDef.Properties.Refresh

	'refresh table list
	TblDef.RefreshLink

End Sub