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

聲 明 一Dynaset 類 型 的Object：tbOLEObjects。

在Form_Load 事 件 的 執(zhí) 行 程 序 中， 將Data1.RecordSet 賦 給tbOLEObjects ， 并 記 錄tbOLEObjects 中 的 記 錄 數(shù)。

在Data1_Validate 事 件 的 執(zhí) 行 程 序 中， 使tbOLEObjects 執(zhí) 行 的 動(dòng) 作 與Data1 一 致， 即： 在Data1 的Data1_Validate 事 件 執(zhí) 行 程 序 中， 當(dāng)Data1 執(zhí) 行Data1.RecordSet.MoveNext 或Data1.RecordSet.MoveFirst 時(shí)，tbOLEObjects 也 要 執(zhí) 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst。 實(shí) 現(xiàn) 時(shí)， 先 保 存 當(dāng) 前OLE 控 件 中 的 內(nèi) 容， 然 后 執(zhí) 行tbOLEObjects.MoveNext 或tbOLEObjects.MoveFirst 方 法， 再 取 出OLE 字 段 中 的 內(nèi) 容， 插 入 到OLE 控 件 中。

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

Option Explicit

Dim tbOLEObjects As Dynaset
Dim nRecordCount As Integer 'tbOLEObjects 的 記 錄 數(shù)
Dim nRecordNumber As Integer 'tbOLEObjects 的 記 錄 指 針
Dim bBusy As Interger ' 防 止 重 入 標(biāo) 志
Dim bUpdated As Integer 'OLE 控 件 的 內(nèi) 容 發(fā) 生 變 化 的 標(biāo) 志
下 面 的 過 程 要 在 窗 口 的Form_Load 事 件 中 執(zhí) 行， 完 成 對(duì)tbOLEObjects 賦 值 并 計(jì) 算 出tbOLEObjects 中 的 記 錄 數(shù)。
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 賦 值
' 下 面 這 兩 條 語(yǔ) 句 是 必 須 的， 否 則 無(wú) 法 求 出tbOLEObjects 中 的 記 錄 數(shù)
tbOLEObjects.MoveLast
tbOLEObjects.MoveFirst
nRecordCount = tbOLEObjects.RecordCount
' 保 存tbOLEObjects 的 記 錄 數(shù)
nRecordNumber = 1
' 使 記 錄 的 指 針 在 第 一 個(gè) 記 錄 上
' 設(shè) 置 各 控 件 的DataField 屬 性， 以 顯 示 其 字 段 的 內(nèi) 容。
txtTitle.DataField = "File_Title"
txtClass.DataField = "File_Class"
txtFileID.DataField = "File_ID"
txtKeyWord.DataField = "File_KeyWord"
' 將OLE 字 段File_Cont 中 的 內(nèi) 容 取 出 并 插 入OLE 控 件OLE1 中
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))

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

Select Case Action
Case 1 'Data1 執(zhí) 行MoveFirst
If Not bBusy Then
bBusy = True
Screen.MousePointer = 11
DoEvents
If bUpdated Then
' 如 果OLE1 中 的 內(nèi) 容 發(fā) 生 了 變 化
Call PutOLEObject
' 保 存OLE1 中 的 內(nèi) 容
DoEvents
bUpdated = False
End If
If nRecordNumber > 1 Then
tbOLEObjects.MoveFirst ' 到Data1 所 指 向 的 記 錄
nRecordNumber = 1 ' 修 改tbOLEObjects 的 指 針
' 取 出 當(dāng) 前 記 錄OLE 字 段 的 內(nèi) 容
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents
End If
Screen.MousePointer = 0
bBusy = False
End If
Case 2 'Data1 執(zhí) 行 了MovePrevious
If Not bBusy Then ' 用 于 防 止 程 序 重 入
bBusy = True '
Screen.MousePointer = 11
DoEvents
If bUpdated Then ' 如 果OLE1 中 的 內(nèi) 容 發(fā) 生 變 化
Call PutOLEObject ' 保 存OLE1 中 的 內(nèi) 容
DoEvents
bUpdated = False
End If
If nRecordNumber > 1 Then
tbOLEObjects.MovePrevious ' 到Data1 所 指 向 的 記 錄
nRecordNumber = nRecordNumber - 1 ' 修 改tbOLEObjects 的 指 針
' 取 出 當(dāng) 前 記 錄OLE 字 段 的 內(nèi) 容
eError = FieldToOLE(OLE1, tbOLEObjects("File_Cont"))
DoEvents
End If
Screen.MousePointer = 0
bBusy = False
End If
Case 3 'MoveNext
......
Case 4 'MoveLast
......
Case 5 ' 增 加 一 個(gè) 新 記 錄
If Not bBusy Then
bBusy = True
Screen.MousePointer = 11
DoEvents
If bUpdated Then
Call PutOLEObject
' 保 存 當(dāng) 前OLE 控 件 中 的 內(nèi) 容
DoEvents
bUpdated = False
End If
'執(zhí)行tbOLEObjects.AddNew，修改tbOLEObjects的記錄數(shù)、指針等
'本例子中未給出這部分代碼，程序中在增加按鈕的Click事件中執(zhí)行
Screen.MousePointer = 0
bBusy = False
End If
Case 6 ' 更 新 數(shù) 據(jù) 庫(kù)
If Save = True Then
If MsgBox
(" 保 存 所 做 的 修 改?", MSGBOX_TYPE) <> YES Then
Action = 0: Save = False
End If
Case 7
' 刪 除 記 錄， 與 增 加 記 錄 的 過 程 作 同 樣 的 考 慮
......
Case 8
......
Case 9
......
Case 10 ' 關(guān) 閉 數(shù) 據(jù) 庫(kù)
If Save = True Then
If MsgBox
(" 關(guān) 閉 數(shù) 據(jù) 庫(kù) 前, 保 存 所 做 的 修 改?", MSGBOX_TYPE)
<> YES Then
Save = False
End If
End Select
End Sub
下 面 的 過 程 是 用 戶 用Outline 控 件 查 找 數(shù) 據(jù) 庫(kù) 中 的Word 文 檔， 每 一 個(gè) 記 錄 對(duì) 應(yīng) 一 個(gè)Outline 條 目， 當(dāng) 用 戶 在Outline 的 某 一 條 目 上 作Click 動(dòng) 作 時(shí)， 系 統(tǒng) 就 顯 示 出 該 記 錄 的 所 有 內(nèi) 容， 包 括OLE 字 段 的 內(nèi) 容。 這 里，tbOLEObjects 在 查 找 記 錄 時(shí)， 使 用 的 是 順 序 查 找 方 法， 讀 者 若 要 加 快 查 找 的 速 度， 可 采 用 其 它 的 查 找 方 法。
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$, ",") ' 讀 取 該 記 錄 的 標(biāo) 志
If nRecordCount > 1 Then
tbOLEObjects.MoveFirst
nRecordNumber = 1 ' 到 第 一 個(gè) 記 錄
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 字 段 的 內(nèi) 容
Outline1.SetFocus
' 將 焦 點(diǎn) 放 在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
最 后， 說(shuō) 明 一 點(diǎn)： 以 上 的 程 序 都 是 在Windows3.2 中 文 版 和VB3 環(huán) 境 下 實(shí) 現(xiàn) 的， 若 在Windows 環(huán) 境 下， 用VB4 編 寫 這 種 程 序， 上 面 的 程 序 要 作 改 動(dòng)， 不 能 直 接 應(yīng) 用。