Sub OO4O()
	Dim EmpDynaset As Object
	Dim OraSession As Object
	Dim OraDatabase As Object
	Dim strSQL As String
	On Local Error Resume Next
	'
	'Connect
	Set OraSession = CreateObject(“OracleInProcServer.XOraSession")
	If Err <> 0 Then
		MsgBox “データベースに接続出来ません。" & vbCrLf _
		  & “CreateObject – Oracle oo4o エラー" & vbCrLf _
		  & “ORACLEクライアントはインストールされていますか？"
		End
	End If
	'
	Set OraDatabase = OraSession.OpenDatabase(“DSN NAME", “USERID/PASSWORD", 0&)
	If Err <> 0 Then
		MsgBox “データベースに接続出来ません。" & vbCrLf _
		  & Err & “: “ & Error & vbCrLf _
		  & “DB接続の設定内容に問題があります。" & vbCrLf _
		  & “Cドライブ内からTNSNAMES.ORAファイルを探し管理者宛に送付してください"
		End
	End If
	'
	On Error GoTo 0
	'SQL
	strSQL = “SELECT * FROM TABLE_NAME WHERE FIELD='A'"
	'Execute
	Set EmpDynaset = OraDatabase.CreateDynaset(strSQL, 0&)
	'loop
	Do While Not EmpDynaset.EOF
		Debug.Assert EmpDynaset(“FIELD_NAME").Value
		EmpDynaset.MoveNext
	End If
	'
	EmpDynaset.Close
	'
	MsgBox “Done!"
	'
End Sub

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