lotuschina
作者lotuschina·2012-01-16 16:54
项目经理·TWT

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

字数 2417阅读 2408评论 0赞 0

 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

如果觉得我的文章对您有用,请点赞。您的支持将鼓励我继续创作!

0

添加新评论0 条评论

Ctrl+Enter 发表

作者其他文章

相关问题

相关资料

X社区推广