Office2010 代碼創(chuàng)建、另存、刪除附件

Grant

用了一天時間寫成了這個東西,準(zhǔn)備融入到客戶管理軟件中去,現(xiàn)在很多客戶電腦都安裝了新的office2010
不得不轉(zhuǎn)型學(xué)習(xí)office2010的新功能,發(fā)現(xiàn)有不少好東西,暫時先研究這個,先貼上來給大家分享一下

1. 
   
2. Option Compare Database
   
3. 
   
4.     '===============================================================================
   
5.     '-函數(shù)名稱:         modAdj
   
6.     '-功能描述:         保存,刪除,添加附件
   
7.     '-輸入?yún)��?shù)說明:     參數(shù)1:strPath As String 目標(biāo)路徑
   
8.     '                   參數(shù)2:strFileName As String 文件名稱
   
9.     '                   參數(shù)3:ID As long    自動編號
   
10.     '-使用語法示例:     AddAdj(自動編號,文件名,路徑)    '添加附件
    
11.     '                   DelAdj(自動編號,文件名)         '刪除附件
    
12.     '                   GetAdj(自動編號,列表框)         '讀取附件
    
13.     '                   GetSave(自動編號,文件名,路徑)   '保存附件
    
14.     '-參考:
    
15.     '-使用注意:
    
16.     '-兼容性:           Office2007,Office2010
    
17.     '-作者:             Grant
    
18.     '-聯(lián)系方式:         QQ:20991943  Email:20991943@qq.com
    
19.     '-更新日期：        2012-01-11
    
20.     '===============================================================================
    
21.   Public Function AddAdj(ID As Long, strFileName As String, strPath As String)  '添加附件
    
22.     Dim db As Database
    
23.     Dim Rstable As Recordset
    
24.     Dim RsAdj As Recordset2
    
25.    
    
26.     '數(shù)據(jù)庫
    
27.     Set db = DBEngine.Workspaces(0).Databases(0)
    
28.    
    
29.     '打開表
    
30.     Set Rstable = db.OpenRecordset("select * from 企業(yè)信息 where ID=" & ID)
    
31. 
    
32. '    While Not Rstable.EOF
    
33. 
    
34.         '獲取附件列的文件集合
    
35.         Set RsAdj = Rstable("附件").Value
    
36.         '往附件列添加文件
    
37.         Rstable.Edit
    
38.         RsAdj.AddNew
    
39.         RsAdj("FileData").LoadFromFile (strPath)
    
40.         RsAdj("FileName") = strFileName
    
41.         RsAdj.Update
    
42.         Rstable.Update
    
43.         Rstable.Close
    
44. 
    
45.   End Function
    
46. 
    
47.   Public Function DelAdj(ID As Long, strFileName As String) '添加附件
    
48.     Dim db As Database
    
49.     Dim Rstable As Recordset
    
50.     Dim RsAdj As Recordset2
    
51.    
    
52.     '數(shù)據(jù)庫
    
53.     Set db = DBEngine.Workspaces(0).Databases(0)
    
54.    
    
55.     '打開表
    
56.     Set Rstable = db.OpenRecordset("select * from 企業(yè)信息 where ID=" & ID)
    
57. 
    
58. '    While Not Rstable.EOF
    
59. 
    
60.         '獲取附件列的文件集合
    
61.         Set RsAdj = Rstable("附件").Value
    
62.         '往附件列添加文件
    
63.         Rstable.Edit
    
64.         While Not RsAdj.EOF
    
65.         
    
66.             If RsAdj("FileName") = strFileName Then
    
67.                 Rstable.Edit
    
68.                 RsAdj.Delete
    
69.                 Rstable.Update
    
70.                 Rstable.Close
    
71.                 Exit Function
    
72.             End If
    
73.             RsAdj.MoveNext
    
74.         Wend
    
75.         Rstable.Close
    
76.   End Function
    
77. 
    
78. Public Function GetAdj(ID As Long, list As ListBox) '獲取附件,讀取到list
    
79.     Dim db As Database
    
80.     Dim Rstable As Recordset
    
81.     Dim RsAdj As Recordset2
    
82. 
    
83.     Set db = DBEngine.Workspaces(0).Databases(0)    '數(shù)據(jù)庫
    
84.     Set Rstable = db.OpenRecordset("select * from 企業(yè)信息 where ID=" & ID) '定位表記錄
    
85. 
    
86.     If Rstable.RecordCount = 0 Then Exit Function     '記錄為0退出
    
87.         
    
88.         Set RsAdj = Rstable("附件").Value
    
89.         While Not RsAdj.EOF                  '循環(huán)
    
90.           list.AddItem RsAdj("FileName")    '讀取文件到列表
    
91.         ' RsAdj("FileData").SaveToFile ("C:\Documents" & rsatts("FileName").Value)
    
92.           RsAdj.MoveNext
    
93.         Wend
    
94.         
    
95.     Rstable.Close
    
96.    
    
97. End Function
    
98. 
    
99. Public Function GetSave(ID As Long, strFileName As String, strPath As String)
    
100.     Dim db As Database
     
101.     Dim Rstable As Recordset
     
102.     Dim RsAdj As Recordset2
     
103.    
     
104.     '數(shù)據(jù)庫
     
105.     Set db = DBEngine.Workspaces(0).Databases(0)
     
106.    
     
107.     '打開表
     
108.     Set Rstable = db.OpenRecordset("select * from 企業(yè)信息 where ID=" & ID)
     
109. 
     
110.         Set RsAdj = Rstable("附件").Value
     
111. 
     
112.         While Not RsAdj.EOF
     
113.         
     
114.             If RsAdj("FileName") = strFileName Then
     
115.                 If Dir(strPath) <> "" Then
     
116.                     Kill strPath
     
117.                 End If
     
118.                
     
119.                 RsAdj("FileData").SaveToFile (strPath)
     
120.                 Rstable.Close
     
121.                 Exit Function
     
122.             End If
     
123.             RsAdj.MoveNext
     
124.         Wend
     
125.         Rstable.Close
     
126. End Function
     
127. 
     

復(fù)制代碼

游客，如果您要查看本帖隱藏內(nèi)容請回復(fù)

JosephTan

看一下。

yanwei82123300

謝謝分享！

godzhong

好東西,先學(xué)習(xí)下

todaynew

建議將增改刪獨(dú)立成為函數(shù)

Grant

todaynew 發(fā)表于 2012-1-11 17:20
建議將SQL語句作為參數(shù)

是的,這個只是初版,很多地方需要完善,本來還想加入寫圖形進(jìn)行美化,不過想想控制不便所以暫時先不加入

zhuyiwen

呵呵，附件，好東西

咱家是貓

我又回來啦.{:soso_e113:}

andymark

謝謝分享��！

sxb2007

謝謝分享��！