给出为文档生成不重复可读性编号的方法

[sacrefies]

Function CreateCounterDocument(Database As notesdatabase, Byval ProcessType As String, CounterDocument As notesdocument, ErrorText As String) As Variant
'process_type
'generate_date
'sequential_num
On Error Goto errhandle
Dim datetime As Variant
Dim continue As Variant

errortext = ""
continue = True
Set CounterDocument = Database.createdocument()
Call CounterDocument.replaceitemvalue("Process_Type", processtype)
continue = getServerDateTime(DateTime, ErrorText)
If continue Then
Call counterdocument.replaceitemvalue("Generated_date", datetime(0))
Call counterdocument.replaceitemvalue("Sequential_num", 0)
Call counterdocument.save(True, True)
End If
CreateCounterDocument = continue
Exit Function
errhandle:
CreateCounterDocument = False
errortext = "Script 库程序 CreateCounterDocument 运行失败，" & Cstr(Erl()) & "：" & Error()
Exit Function
End Function

Function getCounter(Byval ProcessType As String, SerialCode As String, ErrorText As String) As Variant
On Error Goto errhandle
Dim view As notesview
Dim s As New notessession
Dim database As notesdatabase
Dim counterdocument As notesdocument
Dim dc As notesdocumentcollection

Dim currentcounter As Long
Dim theDate, dateNow As String
Dim continue As Variant
Dim i As Integer

Set database = s.currentdatabase
Set view = database.getview("(Sequential Documents View)")
errortext = ""
continue = True
SerialCode = ""
dateNow = Format(Date$, "yyyy-mm-dd")
If view Is Nothing Then
continue = False
errortext = "Script 库程序 GetCounter 警告：未能获得计数器文档集合视图"
Else
Set dc = view.getalldocumentsbykey(processtype, True)
If dc.count < 1 Then
'创建新计数器
continue = CreateCounterDocument(Database, ProcessType, CounterDocument, ErrorText)
Else
'删除冗余计数器文档
If dc.count > 1 Then
For i = 2 To dc.count
Set counterdocument = dc.getnthdocument(i)
Call counterdocument.remove(True)
Next
End If
'获取计数器文档
Set counterdocument = dc.getfirstdocument()
End If
'获取计数器
If continue Then
'检查文档锁定
continue = IfDocumentLocked(CounterDocument, ErrorText)
If continue Then
'获取计数器
'检查日期（包含更新日期）
continue = CheckCounterDate(CounterDocument, dateNow, ErrorText)
If continue Then
continue = PlusCounter(CounterDocument, ErrorText)
If continue Then
currentcounter = Clng(counterdocument.getitemvalue("Sequential_num")(0))
theDate = counterdocument.getitemvalue("generated_date")(0)
theDate = Format(Cstr(Year(theDate)), "0000") & Format(Cstr(Month(theDate)), "00") & Format(Cstr(Day(theDate)), "00")
SerialCode = ProcessType & theDate & Format(currentcounter, "0000")
End If
End If
'解除文档锁定
Call ClearLockWhenClosingFlowdocument(counterDocument, ErrorText)
End If
End If
End If
getCounter = continue
Exit Function
errhandle:
errortext = "Script 库程序 GetCounter 运行失败，" & Cstr(Erl()) & Error()
GetCounter = False
Exit Function
End Function

Function PlusCounter(CounterDocument As notesdocument, ErrorText As String) As Variant
'Plus 1 to the sequential number
On Error Goto errhandle
Dim counter As Long
Dim continue As Variant

continue = True
errortext = ""

counter = Clng(counterdocument.getitemvalue("Sequential_num")(0))
counter = counter + 1
Call counterdocument.replaceitemvalue("Sequential_num", counter)
Call counterdocument.save(True, True)
PlusCounter = continue
Exit Function
errhandle:
errortext = "Script 库程序 PlusCounter 运行失败，" & Cstr(Erl()) & Error()
PlusCounter = False
Exit Function
End Function

'如果检查到计数器得日期不是当天日期，使用当天日期更换，并将计数器清0
Function CheckCounterDate(CounterDocument As notesdocument, Byval dateNow As String, ErrorText) As Variant
On Error Goto errhandle
Dim olddate As notesdatetime
Dim newdate As notesdatetime
Dim continue As Variant
Dim timediffer As Long

continue = True
errortext = ""
If dateNow = "" Then
continue = False
errortext = "未能获得当前日期。处理中断"
Else
If Len(datenow) < 10 Then
continue = False
errortext = "当前日期不是长日期格式或日期格式不正确。处理中断"
Else
If counterdocument Is Nothing Then
continue = False
errortext = "未能获得计数器文档。处理中断"
Else
Set olddate = New notesdatetime(CounterDocument.generated_date(0))
Set newdate = New notesdatetime(dateNow)
timediffer = newdate.Timedifference(olddate)
If timediffer <> 0 Then
Call counterdocument.replaceitemvalue("generated_date", dateNow)
Call counterdocument.replaceitemvalue("Sequential_num", 0)
Call counterdocument.save(True, True)
End If
End If
End If
End If
CheckCounterDate = continue
Exit Function
errhandle:
errortext = "Script 库程序 CheckCounterDate 运行失败，" & Cstr(Erl()) & "：" & Error()
CheckCounterDate = False
Exit Function
End Function

[sacrefies]

调用生成编号的时候，直接调用GetCounter就可以。

说明：
processtype：编号的前缀，比如PV200308070001中的“PV”
函数IfDocumentLocked是检查计数器文档是否正在被访问，可以去掉，我就不帖关于这个的代码了（又是一大摞啊~~）
在CheckCounterDate函数中对输入的日期参数格式的检查有许多解决办法，我这里的很粗浅，不用照搬

[sacrefies]

使用方法：
只能在CS模式下使用，因为在WEB上使用时，Script库中的函数不能使用NotesDatabse这样的参数（修改了函数过后当然就可以了。。。呵呵）

[flgodfather]

不错

[sacrefies]

多谢捧场~~~~

[sacrefies]

忘了一个重要函数：

'--------------------------------------
'获得服务器当前日期、时间
'ServerDateTime: 一个2元的数组，第一个元素是长格式时期（yyyy-mm-dd），第二个元素是24小时制时间（HH-MM，不处理秒）
'ErrorText: 如果运行中出现错误，返回的错误信息
'返回值：是否获得了时间
'--------------------------------------
Function getServerDateTime(ServerDateTime As Variant, ErrorText As String) As Variant
On Error Goto errhandle
Dim s As New notessession
Dim db As notesdatabase
Dim doc As notesdocument
Dim dt As notesdatetime

Dim continue As Variant
Dim tmparray(1) As String

continue = True
errortext = ""
Set db = s.currentdatabase
Set doc = db.createdocument()
If doc Is Nothing Then
continue = False
errortext = "Script 库程序 getServerDateTime 警告：获得服务器时间失败（文档创建失败）。"
Else
Set dt = New notesdatetime(doc.created)
tmparray(0) = Format(dt.dateonly, "yyyy-mm-dd")
tmparray(1) = Format(dt.timeonly, "hh-mm")
ServerDateTime = tmpArray
End If
getServerDateTime = continue
Exit Function
errhandle:
errortext = "Script 库程序 getServerDateTime 运行失败，" & Cstr(Erl()) & Error()
getServerDateTime = False
Exit Function
End Function

[daluoboequalto]

实际上的，会有问题。
视图刷新的问题没有考虑到。
一般的来说，代码以功能为第一，代码的结构、可读性为第二
但是对一些特例的情况，或许要考虑速度和效率，这里的就是。

[sacrefies]

自顶一个

[picker]

楼上的，你有更简洁的方法？