现在的位置: 首页 > 综合 > 正文

lotus notes常用代码

2013年05月16日 ⁄ 综合 ⁄ 共 9738字 ⁄ 字号 评论关闭


lotusnotes常用代码

1.检测当前用户是不是文档的创建者,如果不是,不允许编辑文档。
Sub Querymodechange(Source As Notesuidocument, Continue As Variant)
Dim session As New NotesSession
Dim doc As notesdocument
Dim userName As New NotesName(session.UserName)
Set doc=source.document
If Not ( source.EditMode ) Then
If ( doc.authors(0) = username.CANONICAL ) Then continue=True
Else Msgbox /"您不是此文档的创建人,不可以修改!/",0,/"文档数据库/"
continue=False
End If End If End Sub
2.退出时检测关键的域不能为空
Sub Click(Source As Button)
Dim w As New notesuiworkspace
Dim uidoc As notesuidocument
Dim doc As notesdocument
Set uidoc=w.currentdocument
name1=uidoc.fieldgettext(/"name/")
If name1=/"/" Then
Messagebox /"姓名不能为空!/",0,/"通讯录/"
Exit Sub
End If
Call uidoc.save
Call uidoc.close
End Sub
3.用私有视图来显示需要当前用户处理的文档,用以下视图公式:
注意建立视图时不要选中/"保存到本地/"选项,否则调试不便.
SELECT Form = /"收文1/" & NextApprover=@Name([CN];@V3UserName)
4.Notes中Active控件
当文档中添加OLE或其他通用的ActiveX控件后,在文档的script编辑框右侧中,会自动添
加各种属性和方法在notes的类列表中.在script中声明该对象的 方法如下:
Sub Postopen(Source As Notesuidocument)
Dim w as notesuiworkspace
Dim uidoc as notesuidocument
Dim aa As Variant
Set w =New notesuiworkspace
Set uidoc =w.currentdocument
Set aa=uidoc. getObject(/"Chart/")/'该句为ole对象声明,注意Chart是你给对象起的名
字 /'接下来你就可以通过aa.**来调用其方法和属性了.
End Sub
5.以下是script错误陷阱代码
Sub subname On Error Goto Errcode /'下面添加你的程序代码
Exit Sub Errcode: Msgbox /"错误 (/" & Cstr(Err) & /" ) -> /" & Error$(Err),16,/"错
误提示/"
Exit Sub
End Sub
6.是否保存
在表单中设定一个域,名称为saveoption
下列公式添加到返回按钮中,决定文件退出是否保存
FIELD saveoptions:=/"1/"; 保存 FIELD saveoptions:=/"0/"; 不保存
7.用公式弹出对话框,按确定继续,取消返回.
@If(@DialogBox(/"表单名/";[AutoHorzFit]:[AutoVertFit];/"表单标题/");/"/";@Return(/"
/"))
8.用script弹出对话框,按确定继续,取消返回
Dim w as notesuiworkspace
If Not w.dialogbox(/"表单名/",True,True,False,True,False,False,/"填写/")
Then doc.close/'用户按取消退出
Exit Sub
End If
9.视图中删除文档语句
@Command([EditClear]);
@Command([ViewRefreshFields])
10.检测是否是周末
Dim dt as notesdatetime
call dt.setnow
If Weekday(dt.lslocaltime)=7
Then/'是周六耶,
dt.adjustday(2) /'加两天到星期一
Elseif Weekday(dt.lslocaltime)=1
Then/'周日加一天
dt.adjustday(1)
End If
11.得到当前的服务器和路径
公式: ResideServer := @Subset(@DbName; 1) ;
CurrentPath := @Subset(@DbName; -1) ;
DirOnly := @If(@Contains(CurrentPath; /"/////");
@LeftBack(CurrentPath; /"/////") + /"/////"; /"/");
DbFile := DirOnly + /"***.NSF/";
12.得到当前用户名
公式Name([CN];@V3UserName)
scriptim s as notessession
Dim myname as newnotesname(s.username)
messagebox myname.common
13.得到当前日期公式:
@today @date(@created)
scriptim dt as notesdatetime
Set dt=New notesdatetime(/"/")
Call dt.setnow
14.常用全局对象声明 /'-----对象变量-----
Dim w As NotesUIWorkspace
Dim s As NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim item As NotesItem
Dim dt As NotesDateTime
Dim username as notesname
15.一些计算域,开始时没有值,如果不给它一个值会报错,以下公式给计算域赋值
@if(Bfield=/"/";0;Bfield)
16.特殊字符
@char(13)可以在@prompt提示框中显示回车 script中用函数chr(13)
17.怎样判断视图中没有文档?
 
set doc = vw.getfirstdocument()
 if doc is nothing then
.....

 end if

18.如何将查询结果放到一个文件夹里?
 
下面是将搜索结果放到名叫newfolder的文件夹中,并跳转到该文件夹上
Sub Click(Source As Button) 
Dim docs As notesdocumentcollection         
Dim doc As notesdocument
...........
q=doc.query(0)
Set docs = db.ftsearch(q, 0)
Call docs.PutAllInFolder( /"newfolder/" )
Call w.OpenDatabase( /"/",/"/",/"newfolder/")
End Sub
 
如何删掉数据库中所有私有视图?
 
Dim session As New notessession 
     Dim db As notesdatabase 
     Dim doc As notesdocument 
     Set db=session.currentdatabase 
     Forall i In db.views 
     Set doc=db.getDocumentByUNID(v.universalID) 
     /' 这个地方视图当作文档来处理,以便取到视图的一些属性。 
     viewflag=doc.getItemvalue(/"$flags/") 
     If viewflag(0)=/"pYV/" Then 
     /' 视图属性中$flags为/"pYV/"的是私有视图。 
          Call i.remove 
     End If 
     End Forall
 
如何在Notes中调用ODBC数据源中的进程?
 
下面是一个利用ODBC调用access数据库(资料库)的script代码
 
Dim session As New NotesSession
Dim con As New ODBCConnection
Dim qry As New ODBCQuery
Dim result As New ODBCResultSet
Set qry.Connection = con
Set result.Query = qry
con.ConnectTo(/"资料库/")
qry.SQL = /"SELECT * FROM 资料库/"
result.Execute
If result.IsResultSetAvailable Then
Do
result.NextRow
id=result.GetValue(/"ID/",id)
Loop Until result.IsEndOfData
result.Close(DB_CLOSE)
Else
Messagebox /"Cannot get result set for AssetData/"
Exit Sub
End If
con.Disconnect
End Sub
 
从后台刷新当前文档?
 
将当前文档先关闭后再打开
set doc=uidoc.document
......
call uidoc.save()
call uidoc.close()
set uidoc=ws.editdocument(doc)

获得当前视图中选择了的文档?
 
可以用 Notesdatabase 的 Unprocesseddocuments 属性。

   Dim session As New notessession
   Dim db As notesdatabase
   Dim collection As notesdocumentcollection
  
   Set db = session.currentdatabase
   Set collection = db.UnprocessedDocuments

Unprocesseddocuments 其实很有用的
 
notes和Excel交换数据
 
Dim session As New NotesSession
   Dim db As NotesDatabase
   Dim view As NotesView
   Dim doc As NotesDocument
   Dim excelApplication As Variant
   Dim excelWorkbook As Variant
   Dim excelSheet As Variant
   Dim i As Integer
   
   Set excelApplication = CreateObject(/"Excel.Application/")
   excelApplication.Visible = True
   Set excelWorkbook = excelApplication.Workbooks.Add
   Set excelSheet = excelWorkbook.Worksheets(/"Sheet1/")
   excelSheet.Cells(1,1).Value = /"姓名/"
   excelSheet.Cells(1,2).Value = /"年龄/"
   
   i = 1
   Set db = session.CurrentDatabase
   Set view = db.GetView(/"abc/")
   Set doc = view.GetFirstDocument
   While Not(doc Is Nothing)
     i = i + 1
     excelSheet.Cells(i,1).Value = doc.ClassCategories(0)
     excelSheet.Cells(i,2).Value = doc.Subject(0)
     Set doc = view.GetNextDocument(doc)
   Wend
   excelSheet.Columns(/"A:B/").Select
   excelSheet.Columns(/"A:B/").EntireColumn.AutoFit
   
   excelWorkbook.SaveAs(/"Script 内容/")
   excelApplication.Quit
   Set excelApplication = Nothing  
   
在视图中怎样历遍所有的文档?
 
Dim db As New NotesDatabase( /"Ankara/", /"current//projects.nsf/" )
Dim view As NotesView
Dim doc As NotesDocument
Set view = db.GetView( /"Open//By Due Date/" )
Set doc = view.GetFirstDocument
While Not ( doc Is Nothing )
....................
 Set doc = view.GetNextDocument( doc )
Wend
 
在scipt中如何调用公式

例如我们想要取服务器名的普通名,在script中用@name() ,假设server变量以取到服务器名称
 
在script中用Evaluate可以运行公式,如:servername=Evaluate(/"@name([CN];server)/")
 

怎样用script代理取到CGI变量

Dim session As New NotesSession
Dim doc As NotesDocument
Set doc = session.DocumentContext
Messagebox /"User = /" + doc.Remote_User(0)
 
如何使用Win32API隐藏菜单呢?
 
1. Declarations :

Declare Function GetActiveWindow Lib /"user32.dll/" () As Long
Declare Function SetMenu Lib /"user32.dll/" ( Byval hmenu As Long, Byval newmenu As Long ) As Integer

2.
Sub HiddenMenu()

Dim hwnd As Long
hwnd = GetActiveWindow()
Call SetMenu(hwnd,0)

End Sub 

怎样判断一个RTF为空值
 
Function IsRTFNull(rtfield As String) As Integer  
 On Error Goto Errhandle   
 Dim workspace As New NotesUIWorkspace
 Dim uidoc As NotesUIDocument 
 Set uidoc = workspace.CurrentDocument  
 currentfield = uidoc.CurrentField  
 Call uidoc.GotoField(rtfield) 
 Call uidoc.SelectAll
 Call uidoc.DeselectAll  
 If currentfield <> /"/" Then  
 Call uidoc.GotoField(currentfield) 
 End If  
 IsRTFNull = False   
 Exit Function     
 Errhandle: 
  Select Case Err
  Case 4407
  /'the DeselectAll line generated an error message, indicating that the rich text field does   not contain anything
  If currentfield <> /"/" Then   
  Call uidoc.GotoField(currentfield)  
  End If
  IsRTFNull = True 
  Exit Function 
  Case Else
  /'For any other error, force the same error to cause LotusScript to do the error handling
  Error Err 
  End Select
  End Function

 

怎样返回一个数据的类型
 
Declarations
Class ReturnObj
 Private m_stName As String
 Private m_stType As String
  
 Property Get NameVal As String
  NameVal = m_stName$
 End Property
  
 Property Get TypeVal As String
  TypeVal = m_stType$
 End Property
  
 Sub new( arg_stName$, arg_stType$ )
  m_stName = arg_stName$
  m_stType = arg_stType
 End Sub 
End Class

Function Test() As ReturnObj
 Set Test = New ReturnObj( /"Name/", /"Type/" )
End Function

Initialize
 Dim var
 Set var = Test()
 Msgbox( var.NameVal )

 

怎样判断一个文件目录是否存在

If Dir$(dirName, ATTR_DIRECTORY) = /"/"
Then   /'Directory does not exist
Else
   /'Directory does exist
End If
 
怎样在lotusScript中运行代理

Set s = CreateObject(/"Notes.NotesSession/") 
Set db = s.GETDATABASE(/"/", /"db.nsf/")
 Set a = db.GETAGENT(/"SomeAgent/")
 Call s.SETENVIRONMENTVAR(/"AgentDocID/", /"ABCD/") 
 Call a.RUN
 
怎样才能得到当前数据库的文件路径
 
Public Function
 GetDatabasePath( db As Notesdatabase ) As String
 Dim position As Integer
 position = Instr( db.FilePath, db.FileName )
 GetDatabasePath = Left( db.FilePath , position - 1 )
End Function
 
怎样比较两个日期型的域

mdate1V = document.DateField1(0)
mdate2V = document.DateField2(0)
If mdate1V < mdate2V Then 
  MsgBox /"DATE 1 LESS THEN DATE 2/"
  Else
  MsgBox /"DATE 2 LESS THEN OR EQUAL TO DATE 1/"
End If
 
在Script中做到@mailsend
 
Function SendMailMemo(sendTo As String, _
           cc As String, _
           bcc As String, _
           subject As String, _
           body As String, _
           linkTo As NotesDocument) As Integer
 On Error Goto ErrorHandler
 Dim mailDb As New NotesDatabase(/"/", /"/")
 Dim mailDoc As NotesDocument
 Dim rtItem As NotesRichTextItem

 Call mailDb.OpenMail
 If (mailDb.IsOpen = False) Then Call mailDb.Open(/"/", /"/")
 Set mailDoc = mailDb.CreateDocument
 mailDoc.Form = /"Memo/"
 mailDoc.SendTo = sendTo
 mailDoc.CC = cc
 mailDoc.BCC = bcc
 mailDoc.Subject = subject
 Set rtItem = mailDoc.CreateRichTextItem(/"Body/")
 Call rtItem.AppendText(body)
 If Not(linkTo Is Nothing) Then
  Call rtItem.AddNewLine(2)
  Call rtItem.AppendDocLink(linkTo, /"Double-click to open document/")
 End If
 Call mailDoc.Send(False)
 SendMailMemo = True
 Exit Function

ErrorHandler:
 Print /"Error /" & Str$(Err) & /": /" & Error$
 Resume TheEnd

TheEnd:
 SendMailMemo = False
End Function

怎样用lotusScript启动附件
 
首先使用EmbeddedObjects类将附件拆离到一个临时文件夹里,然后用shell命令语句运行它

怎样在lotusScript中创建一个姓名域、读者域、作者域

创建一个/"specialType/"姓名域
 Dim variableName As New NotesItem( notesDocument, name$, value [,specialType%])
创建一个/"Author/"作者域
 Dim TAuthor As New NotesItem(doc, /"Author/", Auths, AUTHORS)
TAuthor.IsSummary = True
 

修改了主文档后,怎样自动修改答复文档
 
Sub QuerySave(Source As Notesuidocument, Continue As Variant)
 Dim Collection As NotesDocumentCollection
 Dim Doc As NotesDocument
 Dim Form, ParentStatus, Status As String   
 Set Doc = Source.Document
 Set Collection = Doc.Responses 
 Set Doc = Collection.GetFirstDocument
 ParentStatus = Source.FieldGetText(/"STATUS/") 
While Not ( Doc Is Nothing )
  Form = Doc.GetItemValue(/"Form/")(0)  
  Status = Doc.GetItemValue(/"Status/")(0)
  If (Form = /"TASK/")And (Status <> ParentStatus) Then
   Call Doc.ReplaceItemValue( /"STATUS/", ParentStatus )
   Call Doc.Save (True, False)  
  End If
  Set Doc = Collection.GetNextDocument(Doc) 
  WendEnd
Sub
 
怎样及时取到服务器的时间
 
dim doc as notesdocument
set doc = Serverdb.Createdocument
createDate = doc.Created
............
最后不要让该文档存盘

lotusScripts中怎样在字符串里加回车?

/"aaa/"+chr(10)+/"bbb/" 
 

怎样屏蔽用户用Delete键删除文件
 
在数据库Script中的Querydocumentdelete中使用下列语句。
Continue=False

转帖:http://bbs.chinalotus.com/attachment.php?aid=2887

抱歉!评论已关闭.