刷新指定目录下的模块信息

来源:互联网 发布:2017ipad视频软件 编辑:程序博客网 时间:2024/04/24 19:08

 Sub Initialize
 On Error Goto OnErrDo
 Dim Session As NotesSession
 Dim TDB  As NotesDatabase
 Dim AimDB  As NotesDatabase
 Dim TDoc  As NotesDocument
 Dim SDoc  As NotesDocument
 Dim NewDBDoc As NotesDocument
 Dim DC  As NotesDocumentCollection
 Dim Paths(0 To 2) As String
 
 Set Session = New NotesSession
 Set TDB  = Session.CurrentDatabase
 Set TDoc  = Session.DocumentContext
 
'=======================删除原模块信息文档====================== 
 Query = "form='FormWeb_DBAdd'"
 Set DC = TDB.Search(Query,Nothing,0)
 If DC.Count > 0 Then
  Call DC.RemoveAll(True)
 End If
'=======================更新模块信息文档======================  
 AppPath  = “highcomoa”

 Directory  = Session.GetEnvironmentString("Directory",True) 
 Paths(0)  = Directory+"\"+AppPath+"\"
 Paths(1)  = Directory+"\"+AppPath+"\application\"
 Paths(2)  = Directory+"\"+AppPath+"\public\"
 
 For i=0 To Ubound(Paths)
  fileName$ = Dir$(Paths(i),16)
  Do While fileName$ <> ""
   Set AimDB = New NotesDatabase("","")
   If Right(Lcase(fileName$),4) = ".nsf" Then 
    
    If AimDB.Open("",Paths(i)+fileName$) Then
     
     Set NewDBDoc = New NotesDocument(TDB)
     NewDBDoc.form = "FormWeb_DBAdd"
     NewDBDoc.DocID = NewDBDoc.UniversalID
     NewDBDoc.Chr_DBtitle = AimDB.Title
     NewDBDoc.Chr_DBname = fileName$
     NewDBDoc.Chr_DBpath = Right(Paths(i),Len(Paths(i))-Len(Directory)-1)
     
     Call NewDBDoc.Save(True,True)
    End If
   End If
   fileName$ = Dir$()
  Loop
 Next
'============================================================= 
 
 Exit Sub
OnErrDo:
 Print "<h1> 警告!</h1>"
 Print "错误信息" & Str(Err) & ": " & Error$ & "错误行:" & Erl
End Sub