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