一、引言
對於工程項目管理來說，工程文件資料管理是其中一項重要的工作，其保密性也是至關重要的一項內容。好的資料管理能顯著提高工程建設過程中資料審查的工作效率，電子文件能否很好的得到存取也是保密所需要考慮的內容。
二、實現思路
為能更好的做好文件資料的管理，采用以下幾點原則：
1、考慮各工作站大多都安裝了office2000以上版本的軟件，采用ACCESS數據庫來存取文件。
2、采用流對象保存和顯示各類文件，同一類的內容可以作為一個壓縮文件保存到數據庫的一條記錄裡，在數據庫的表裡采用長二進制的形式用一個OLE對象字段類型來保存文件內容，並對每個歸檔文件按類別進行編號保存。
3、讀取文件時采用調用一個自定義的打開文件函數shellfile()的形式完成。在打開文件時考慮文件是否在臨時目錄裡已經存在，避免程序代碼出現錯誤。
4、考慮程序的通用性，可由用戶指定其原始文件的存放路徑，程序按用戶指定的路徑來進行文件讀取。設定一個臨時文件夾d:lzzl在讀取並打開文件時臨時存放，在關閉打開的文件時，清空此文件夾下的所有文件。
三、程序設計
向數據庫裡寫文件的界面如下圖所示：
界面采用常用的一些控件，在程序裡以字符串形式定義了其與數據庫的連接。讀取文件的界面設計如下圖所示：
通過有條件的查詢，得到想要的結果，在list控件裡顯示查詢的結果文件名稱，在datagrid控件裡顯示查詢到的記錄信息。選中list裡的結果，在操作“打開文件”按鈕來調用函數完成打開數據庫裡的文件的過程。
四、文件存取實例
1、文件寫入數據庫的實例
Dim cn0 As ADODB.Connection '定義連接
Dim rs0 As ADODB.Recordset '定義記錄集
Dim strcn0 As String
Private Sub Combo1_LostFocus()
If Combo1.Text = "綜合" Then Text1 = "2972901"
If Combo1.Text = "酸軋" Then Text1 = "2972902"
If Combo1.Text = "連退" Then Text1 = "2972903"
If Combo1.Text = "熱鍍鋅1" Then Text1 = "2972904"
If Combo1.Text = "熱鍍鋅2" Then Text1 = "2972905"
If Combo1.Text = "彩塗" Then Text1 = "2972906"
If Combo1.Text = "精整" Then Text1 = "2972907"
If Combo1.Text = "其它" Then Text1 = "2972908"
Combo2.Enabled = True
End Sub
If Combo2.Text = "綜合類" Then Text1 = Text1 & "01"
If Combo2.Text = "總圖、運輸" Then Text1 = Text1 & "02"
If Combo2.Text = "工藝" Then Text1 = Text1 & "03"
If Combo2.Text = "土建" Then Text1 = Text1 & "04"
If Combo2.Text = "給排水" Then Text1 = Text1 & "05"
If Combo2.Text = "采暖、通風" Then Text1 = Text1 & "06"
If Combo2.Text = "熱力燃氣" Then Text1 = Text1 & "07"
If Combo2.Text = "計控、電訊" Then Text1 = Text1 & "08"
If Combo2.Text = "供電、電氣" Then Text1 = Text1 & "09"
If Combo2.Text = "設備、設備安裝" Then Text1 = Text1 & "10"
If Combo2.Text = "其它專業" Then Text1 = Text1 & "11"
Combo2.Enabled = False
'Dim MyFile
Dim a1, a2 As String
a2 = "000"
If rs0.State = adStateOpen Then rs0.Close
rs0.Open "SELECT * FROM 資料信息 " & _
"WHERE 文件編號 like '%" & Trim(Text1) & "%' order by 文件編號", strcn0, , , adCmdText '選擇條件
Do While Not rs0.EOF
a1 = Mid(rs0!文件編號, 10, 3)
If a2 <= a1 Then a2 = a1
rs0.MoveNext
Loop
rs0.Close
Dim s1 As String
If a2 + 1 < 10 Then s1 = "00" & a2 + 1
If a2 + 1 >= 10 And a2 + 1 < 100 Then s1 = "0" & a2 + 1
If a2 + 1 >= 100 And a2 + 1 < 1000 Then s1 = a2 + 1
Text1 = Mid(Text1, 1, 9) & s1
End Sub
Private Sub Command1_Click()
If Trim(Text1) = "" Then
MsgBox "此文件編號不允許為空！", vbOKOnly + vbCritical, "警告"
Exit Sub
End If
'查看此文件是否存在
If Trim(Text5) <> "" Then
Dim astr As String
astr = Dir(Text5 & Text4)
If astr = "" Then
MsgBox "此文件不在指定的文件夾裡，請核對！", vbOKOnly, "提示"
Exit Sub
End If
End If
If rs0.State = adStateOpen Then rs0.Close
rs0.Open "SELECT * FROM 資料信息 " & _
"WHERE 文件編號='" & Trim(Text1) & "' ", strcn0, , , adCmdText '選擇條件
If rs0.EOF Then
rs0.AddNew
rs0!工程項目名 = Trim(Combo1)
rs0!基建檔案類名 = Trim(Combo2)
rs0!文件編號 = Trim(Text1)
rs0!收件人 = Trim(Text2)
rs0!發件人 = Trim(Text3)
rs0!資料名 = Trim(Text4)
rs0!存放路徑 = Trim(Text5)
rs0!文件說明 = Trim(Text6)
rs0!文本歸檔位置 = Trim(Text7)
rs0!收到時間 = Format(DTPicker0, "yyyy-mm-dd")
rs0!轉交時間 = Format(DTPicker1, "yyyy-mm-dd")
rs0!歸檔時間 = Format(DTPicker2, "yyyy-mm-dd")
rs0!歸檔人 = Trim(Text11)
rs0!擬定密級 = Trim(Combo3)
rs0.UpdateBatch
rs0.Close
'////////////////寫文件到數據庫字段wj
If Trim(Text4) <> "" And Trim(Text5) <> "" Then
Dim iStm As ADODB.Stream
'讀取文件到內容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二進制模式
.Open
.LoadFromFile Text5 & Text4
End With
If rs0.State = adStateOpen Then rs0.Close
rs0.Open "SELECT * FROM 資料信息 WHERE 文件編號='" & Trim(Text1) & "' ", strcn0, , , adCmdText '選擇條件
rs0!wj = iStm.Read
rs0.UpdateBatch
rs0.Close
'完成後關閉對象
iStm.Close
'/////////////
'刪除原文件
Kill Text5 & Text4
End If
MsgBox "此文件編號歸檔保存完成！", vbOKOnly, "提示"
Else
MsgBox "此文件編號已經存在，請核對後處理！", vbOKOnly + vbCritical, "提示"
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And Not (TypeOf Me.ActiveControl Is Command) Then
SendKeys "{TAB}"
End If
If KeyCode = vbKeyEscape Then
Unload Me
End If
End Sub
Private Sub Form_Load()
Set cn0 = New ADODB.Connection
'連接信息賦予字符串
strcn0 = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=" & App.Path & "datebase.mdb"
Catalog=" & App.Path & "DateBase"
cn0.Open strcn0
Set rs0 = New ADODB.Recordset
Set rs0.ActiveConnection = cn0
rs0.CursorType = adOpenKeyset
rs0.LockType = adLockBatchOptimistic
Text11.Text = name1
DTPicker1.Value = Now
DTPicker2.Value = Now
DTPicker0.Value = Now
End Sub
2、從數據庫裡讀取文件並浏覽的過程實例
Dim cn0 As ADODB.Connection '定義連接
Dim rs0, Rs1 As ADODB.Recordset '定義記錄集
Dim strcn0, str1 As String
Dim a0 As String '記錄打開的文件
Private Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
If Trim(Text1) <> "" Then str1 = "SELECT * FROM 資料信息 where 資料名 like '%" & Trim(Text1) & "%' "
If Trim(Text2) <> "" Then
If str1 <> "" Then
str1 = str1 & " and 文件編號 like '%" & Text2 & "%' "
Else
str1 = "SELECT * FROM 資料信息 where 文件編號 like '%" & Text2 & "%' "
End If
End If
If Trim(Text3) <> "" Then
If str1 <> "" Then
str1 = str1 & " and 文件說明 like '%" & Text3 & "%' "
Else
str1 = "SELECT * FROM 資料信息 where 文件說明 like '%" & Text3 & "%' "
End If
End If
If str1 = "" Then str1 = " SELECT * FROM 資料信息 "
If rs0.State = adStateOpen Then rs0.Close
rs0.Open str1, strcn0, , , adCmdText '選擇條件
If Not rs0.EOF Then
rs0.MoveFirst
List1.Clear
Do While Not rs0.EOF
If Not IsNull(rs0!存放路徑) And rs0!存放路徑 <> "" Then
List1.AddItem rs0!存放路徑 & rs0!資料名
End If
rs0.MoveNext
Loop
Set DataGrid1.DataSource = rs0
Else
MsgBox "沒有滿足要求的文件資料！", vbOKOnly, "提示"
Exit Sub
End If
End Sub
Private Sub Command2_Click()
If List1.Text <> "" Then
'讀取數據庫裡的字段wj裡的文件
Dim iStm As ADODB.Stream
'得到最新添加的紀錄
If Rs1.State = adStateOpen Then Rs1.Close
Rs1.Open str1, strcn0, adOpenKeyset, adLockReadOnly
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write Rs1!wj
'這裡注意了,如果當前目錄下存在此文件,會報一個文件寫入失敗的錯誤.
Dim astr As String
astr = Dir("d:lzzl*.*")
If astr <> "" Then Kill "d:lzzl*.*"
.SaveToFile List1.Text
End With
iStm.Close
'//////////
Call Shellfile(List1.Text) 'rs0!存放路徑 & rs0!資料名)
Rs1.Close
Else
MsgBox "請注意！您沒有選擇需要打開的文件！", vbOKOnly + vbCritical, "提示"
End If
'Kill List1.Text
End Sub
Private Sub Form_Load()
Set cn0 = New ADODB.Connection
strcn0 = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=lzzl;Initial Catalog=" & App.Path & "DateBase"
cn0.Open strcn0
Set rs0 = New ADODB.Recordset
Set rs0.ActiveConnection = cn0
rs0.CursorType = adOpenKeyset
rs0.LockType = adLockBatchOptimistic
Set Rs1 = New ADODB.Recordset
Set Rs1.ActiveConnection = cn0
Rs1.CursorType = adOpenKeyset
Rs1.LockType = adLockBatchOptimistic
End Sub
