DoEvents
End Sub
因 為Access1.x 的OLE 字 段 格 式 與OLE2 字 段 的 格 式 不 同， 所 以， 若 是OLE2 字 段， 在 讀 取 字 段 內 容 時， 應 使 用FieldToOLE 函 數； 若 是Access1.x 的 OLE 字 段， 應 使 用AccessFieldToOLE 函 數。 這 兩 種 格 式OLE 字 段 的 存 貯 過 程 是 相 同 的。 當 使 用Access2.0 建 立 數 據 庫 并 存 貯OLE 字 段 時， 它 是OLE2 格 式 的， 應 使 用FieldToOLE 函 數。 用VB3 編 程 時， 系 統 中 應 安 裝VB/Access2.0 兼 容 層， 否 則 無 法 操 縱Access2.0 數 據 庫。
第 二、 如 何 使Data 控 件 顯 示 的 記 錄 與OLE 字 段 的 內 容 同 步。
這 個 問 題 是 因 為Data 控 件 不 支 持 超 長 的OLE 字 段 引 起 的。 對 于 普 通 的 數 據 庫 字 段， 把 顯 示 該 字 段 內 容 控 件 的DataSource 和DataField 屬 性 分 別 置 為Data 控 件 和 數 據 庫 的 字 段 名， 就 可 以 由Data 控 件 正 確 地 顯 示 數 據 庫 記 錄 的 字 段 內 容。 而 用 于 顯 示OLE2 字 段 內 容 的OLE 控 件 的 數 據 是 無 法 用Data 控 件 來 存 取 的， 必 須 用 上 面 提 供 的 函 數 來 存 取。 這 時， 關 鍵 問 題 是 使OLE 控 件 顯 示 的 內 容 是Data 控 件 所 在 記 錄 中OLE 字 段 的 內 容， 也 就 是OLE 控 件 要 與Data 控 件 同 步。
實 現 方 法：

聲 明 一Dynaset 類 型 的Object：tbOLEObjects。

在Form_Load 事 件 的 執 行 程 序 中， 將Data1.RecordSet 賦 給tbOLEObjects ， 并 記 錄tbOLEObjects 中 的 記 錄 數。

在Data1_Validate 事 件 的 執 行 程 序 中， 使tbOLEObjects 執 行 的 動 作 與Data1 一 致， 即： 在Data1 的Data1_Validate 事 件 執 行 程 序 中， 當Data1 執 行Data1.RecordSet.MoveNext 或Data1.RecordSet.MoveFirst 時，tbOLEObjects 也 要 執 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst。 實 現 時， 先 保 存 當 前OLE 控 件 中 的 內 容， 然 后 執 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst 方 法， 再 取 出OLE 字 段 中 的 內 容， 插 入 到OLE 控 件 中。

當 系 統 執 行 了 一 個SQL 語 句 后，Data1 顯 示 的 記 錄 直 接 跳 到 某 一 記 錄， 對tbOLEObjects 來 說， 則 要 執 行 一 查 找 過 程， 使 得tbOLEObjects 的 當 前 記 錄 與Data1 的 當 前 記 錄 一 致。 實 現 時， 先 保 存 當 前OLE 控 件 中 的 內 容， 再 在tbOLEObjects 中 查 找Data1 的 當 前 記 錄， 找 到 后， 將 其OLE 字 段 中 的 內 容 取 出 并 插 入 到OLE 控 件 中。
下 面 給 出 的 實 現 例 子 是 從 本 人 編 寫 的 一 個 軟 件 中 摘 錄 出 來 的， 它 說 明 了 具 體 的 實 現 方 法， 但 不 可 以 直 接 使 用， 要 結 合 自 己 的 程 序， 加 上 其 它 必 要 的 部 分。 例 子 中 的 數 據 庫 是 一 個 公 文 數 據 庫， 保 存 用 戶 的 重 要 公 文， 其 中 的OLE 字 段 保 存 的 就 是Word 文 檔， 名 字 為File_Cont， 其 它 字 段 是 文 檔 的 相 關 信 息， 如 文 檔 的 標 題(File_Title)、 等 級(File_Class)、 關 鍵 字(File_Keyword) 和ID 號(File_ID) 等。
變 量 說 明：

Option Explicit

Dim tbOLEObjects As Dynaset
Dim nRecordCount As Integer 'tbOLEObjects 的 記 錄 數
Dim nRecordNumber As Integer 'tbOLEObjects 的 記 錄 指 針
Dim bBusy As Interger ' 防 止 重 入 標 志
Dim bUpdated As Integer 'OLE 控 件 的 內 容 發 生 變 化 的 標 志
下 面 的 過 程 要 在 窗 口 的Form_Load 事 件 中 執 行， 完 成 對tbOLEObjects 賦 值 并 計 算 出tbOLEObjects 中 的 記 錄 數。
Sub RefreshForm()
Dim eError As Integer

NoRecord = False
Data1.RecordSource = "SELECT * from OwnFile order by File_ID"
Data1.Refresh
Set tbOLEObjects = Data1.Recordset.Clone()
' 給tbOLEObjects 賦 值
' 下 面 這 兩 條 語 句 是 必 須 的， 否 則 無 法 求 出tbOLEObjects 中 的 記 錄 數
tbOLEObjects.MoveLast
tbOLEObjects.MoveFirst
nRecordCount = tbOLEObjects.RecordCount
' 保 存tbOLEObjects 的 記 錄 數
nRecordNumber = 1
' 使 記 錄 的 指 針 在 第 一 個 記 錄 上
' 設 置 各 控 件 的DataField 屬 性， 以 顯 示 其 字 段 的 內 容。
txtTitle.DataField = "File_Title"
txtClass.DataField = "File_Class"
txtFileID.DataField = "File_ID"
txtKeyWord.DataField = "File_KeyWord"
' 將OLE 字 段File_Cont 中 的 內 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))

' 將Data1 指 向 第 一 個 記 錄
If Data1.Recordset.RecordCount > 1 Then Data1.Recordset.MoveFirst
End Sub
下 面 是 如 何 在Data1_Validate 事 件 中 加 入 對tbOLEObjects 操 作 代 碼 的 例 子。
Sub Data1_Validate(Action As Integer, Save As Integer)
Dim eError As Integer

Select Case Action
Case 1 'Data1 執 行MoveFirst
If Not bBusy Then
bBusy = True
Screen.MousePointer = 11
DoEvents
If bUpdated Then
' 如 果OLE1 中 的 內 容 發 生 了 變 化
Call PutOLEObject
' 保 存OLE1 中 的 內 容
DoEvents
bUpdated = False
End If
If nRecordNumber > 1 Then
tbOLEObjects.MoveFirst ' 到Data1 所 指 向 的 記 錄
nRecordNumber = 1 ' 修 改tbOLEObjects 的 指 針
' 取 出 當 前 記 錄OLE 字 段 的 內 容
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents
End If
Screen.MousePointer = 0
bBusy = False
End If
Case 2 'Data1 執 行 了MovePrevious
If Not bBusy Then ' 用 于 防 止 程 序 重 入
bBusy = True '
Screen.MousePointer = 11
DoEvents
If bUpdated Then ' 如 果OLE1 中 的 內 容 發 生 變 化
Call PutOLEObject ' 保 存OLE1 中 的 內 容
DoEvents
bUpdated = False
End If
If nRecordNumber > 1 Then
tbOLEObjects.MovePrevious ' 到Data1 所 指 向 的 記 錄
nRecordNumber = nRecordNumber - 1 ' 修 改tbOLEObjects 的 指 針
' 取 出 當 前 記 錄OLE 字 段 的 內 容
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents
End If
Screen.MousePointer = 0
bBusy = False
End If
Case 3 'MoveNext
......
Case 4 'MoveLast
......
Case 5 ' 增 加 一 個 新 記 錄
If Not bBusy Then
bBusy = True
Screen.MousePointer = 11
DoEvents
If bUpdated Then
Call PutOLEObject
' 保 存 當 前OLE 控 件 中 的 內 容
DoEvents
bUpdated = False
End If
'執行tbOLEObjects.AddNew，修改tbOLEObjects的記錄數、指針等
'本例子中未給出這部分代碼，程序中在增加按鈕的Click事件中執行
Screen.MousePointer = 0
bBusy = False
End If
Case 6 ' 更 新 數 據 庫
If Save = True Then
If MsgBox
(" 保 存 所 做 的 修 改?", MSGBOX_TYPE) <> YES Then
Action = 0: Save = False
End If
Case 7
' 刪 除 記 錄， 與 增 加 記 錄 的 過 程 作 同 樣 的 考 慮
......
Case 8
......
Case 9
......
Case 10 ' 關 閉 數 據 庫
If Save = True Then
If MsgBox
(" 關 閉 數 據 庫 前, 保 存 所 做 的 修 改?", MSGBOX_TYPE)
<> YES Then
Save = False
End If
End Select
End Sub
下 面 的 過 程 是 用 戶 用Outline 控 件 查 找 數 據 庫 中 的Word 文 檔， 每 一 個 記 錄 對 應 一 個Outline 條 目， 當 用 戶 在Outline 的 某 一 條 目 上 作Click 動 作 時， 系 統 就 顯 示 出 該 記 錄 的 所 有 內 容， 包 括OLE 字 段 的 內 容。 這 里，tbOLEObjects 在 查 找 記 錄 時， 使 用 的 是 順 序 查 找 方 法， 讀 者 若 要 加 快 查 找 的 速 度， 可 采 用 其 它 的 查 找 方 法。
Sub Outline1_Click()
Dim stLName As String, stTmp$, eError%
Dim stFName As String

If Outline1.Indent(Outline1.ListIndex) = 2 Then
stTmp$ = Outline1.List(Outline1.ListIndex)
stLName = stGetToken$(stTmp$, ",") ' 讀 取 該 記 錄 的 標 志
If nRecordCount > 1 Then
tbOLEObjects.MoveFirst
nRecordNumber = 1 ' 到 第 一 個 記 錄
Do While Trim$(tbOLEObjects!File_ID) <> stLName
' 開 始 查 找 該 記 錄
nRecordNumber = nRecordNumber + 1
tbOLEObjects.MoveNext
Loop
Data1.Recordset.FindFirst "File_ID = '" + stLName + "'"
'Data 控 件 也 要 到 該 記 錄
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
' 取 出OLE 字 段 的 內 容
Outline1.SetFocus
' 將 焦 點 放 在Outline 控 件 上
ElseIf nRecordCount = 1 Then
Data1.Recordset.FindFirst "File_ID = '" + stLName + "'"
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
Outline1.SetFocus
End If
End If
End Sub
最 后， 說 明 一 點： 以 上 的 程 序 都 是 在Windows3.2 中 文 版 和VB3 環 境 下 實 現 的， 若 在Windows 環 境 下， 用VB4 編 寫 這 種 程 序， 上 面 的 程 序 要 作 改 動， 不 能 直 接 應 用。