您是不是常常為了要幫表單自動產生流水單號 或文件編號而困擾啊?是否為了不同之編碼規則就必須撰寫不同之程式來產生?這些困擾,可能在您看過本期技術分享之資料後,大概就都可以解決以上之困擾,亦或是自行修改程式加強本範例之程式功能。
製作方法如下:
1. 請先在資料庫建立編號管理之套表,套表內容如下:
2. 將套表之主要內容全部放到控制存取小節內,小節內之編輯者為具備有”[SystemAdmin]”角色之User。
3. 建立一名為”FormNo”之ScriptLibrary,程式內容如下:
Option Public
'定義各常數
Const FormNoForm = "FormNo"
Const FormNo_Name = "FormNoName"
Const FormNo_Format = "FormNoFormat"
Const FormNo_Count = "FormNoCount"
Const FormNo_Status = "FormNoStatus"
Const FormNo_Idle = "1"
Const FormNo_Using = "0"
Const FormNo_YearSp = "$"
Const FormNo_ShortYearMark = "$YY$"
Const FormNo_LongYearMark = "$YYYY$"
Const FormNo_VarString="$STRING$"
Const FormNo_NumSp = "%"
Const FormNo_NumMark = "N"
Dim SS As NotesSession
Dim CurrentDb As NotesDatabase
Dim dt As NotesDateTime
Dim CurrentPath As String
-----------------------------------------------------------------------------
Function ComplieFormNo(Byval SysMode As String,Byval count As Long,Byval varstring As String, ReturnNo As String) As Integer
'負責編碼之主要Function
'參數說明:
'SysMode ==>表單編號格式字串
'count ==>最後編號值
'varstring ==> 如果表單編號格式內含有$STRING$字串且varstring不為空值,則$STRING$字串會由varstring取代
'ReturnNo ==>編碼後之結果值
Dim ModeStr As String
Dim n As Integer,n1 As Integer,n2 As Integer
Dim s1 As String,s2 As String
Dim ShortYear As Integer,LongYear As Integer
Dim ZoStr As String
Dim num As Integer
Dim NoStr As String
Dim ServerTime As String
Dim pos As Integer
ServerTime=""
ZoStr="00000000000000000000000000"
ModeStr=SysMode
n=Instr(SysMode,FormNo_ShortYearMark)
If n>0 Then
ServerTime=GetServerDate()
s1=Left(SysMode,n-1)
s2=Right$(SysMode,Len(SysMode)-(n+Len(FormNo_ShortYearMark))+1)
If Year(Cdat(ServerTime))>1000 Then
ShortYear=Year(Cdat(ServerTime)) Mod 100
Else
ShortYear=(Year(Cdat(ServerTime))+1911) Mod 100
End If
SysMode=s1+Right("00"+Cstr(ShortYear),2)+s2
End If
n=Instr(SysMode,FormNo_LongYearMark)
If n>0 Then
s1=Left(SysMode,n-1)
s2=Right$(SysMode,Len(SysMode)-(n+Len(FormNo_LongYearMark))+1)
If ServerTime="" Then
ServerTime=GetServerDate()
End If
SysMode=s1+Cstr(Year(Cdat(ServerTime)))+s2
End If
n1=Instr(1,SysMode,FormNo_NumSp)
If n1<1 Then Exit Function
n2=Instr(n1+1,SysMode,FormNo_NumSp)
If n2<1 Then Exit Function
s1=Left$(SysMode,n1-1)
s2=Right$(SysMode,Len(SysMode)-n2)
num=n2-n1-1
If num<1 Then Exit Function
If Len(Cstr(count+1))<num Then
NoStr=ZoStr+Cstr(count+1)
NoStr=Right(NoStr,num)
Else
NoStr=Cstr(count+1)
End If
ReturnNo=s1+NoStr+s2
If Trim(varstring) <> "" Then
pos = Instr(ReturnNo, FormNo_VarString)
If pos > 0 Then
ReturnNo = Left(ReturnNo,pos-1) + varstring+ Right(ReturnNo, Len(ReturnNo)-pos-Len(FormNo_VarString)+1)
End If
End If
ComplieFormNo=True
End Function
-----------------------------------------------------------------------------
Function GetFormNo(Byval FormNoDBPath As String,Byval FormNoType As String, Byval varstring As String) As String
'獲取表單編號之Function
'參數說明:
'FormNoDBPath ==>表單編號管理資料庫所在之資料庫路徑
'FormNoType ==>表單編號名稱
'varstring ==> 如果表單編號格式內含有$STRING$字串且varstring不為空值,則$STRING$字串會由varstring取代
Dim NoDb As n otesdatabase
Dim docs As notesdocumentcollection
Dim doc As notesdocument
Dim YearListItem As NotesItem
Dim YearNoListItem As NotesItem
Dim query As String
Dim FormNo As String
Dim SysMode As String
Dim SysCount As Integer
Dim LostCount As Integer
Dim retrynum As Integer
Dim YearNo As Integer
Set ss = New NotesSession
Set CurrentDb = ss.CurrentDatabase
Set dt = New NotesDateTime("1980-01-01")
Curre ntPath=Left(CurrentDb.FilePath,Len(CurrentDb.FilePath)-Len(CurrentDb.FileName))
retrynum=0
On Error Goto errl
GetFormNo=""
If Trim(FormNoType)="" Then Exit Function
retry:
If retrynum>15 Then
Msgbox |表單編號錯誤:|+FormNoType,64,"表單編號"
Exit Function
End If
Set NoDb=ss.GetDatabase(CurrentDb.Server,FormNoDBPath)
If NoDb Is Nothing Then Exit Function
If Not (NoDb.IsOpen) Then Exit Function
query=|Form="|+FormNoForm+|" & |+ FormNo_Name+| =" |+FormNoType+|"|
Set docs=NoDb.Search(query,dt,0)
If docs.count<>1 Then
Msgbox |在表單編號資料庫中找不到以下類型的編號記錄檔案:|+FormNoType+|請通知系統管理員檢查表單編號資料庫。|,64," 表單編號"
Exit Function
End If
Set doc=docs.getfirstdocument
If doc.getitemvalue(FormNo_Status)(0)=FormNo_Using Then
retrynum=retrynum+1
Goto retry
Else
Call doc.replaceitemvalue(FormNo_Status,FormNo_Using)
If doc.save(False,False)=False Then
Goto retry
End If
End If
SysMode=doc.FormNoFormat(0)
LostCount=doc.FormNoLost(0)
Set YearListItem=doc.GetFirstItem("YearList")
Set YearNoListItem=doc.GetFirstItem("YearNoList")
YearNo=Year(Cdat(GetServerDate()))
If (Trim(Cstr(doc.FormNoYear(0)))="") Or (Trim(Cstr(doc.FormNoYear(0)))="0") Then
doc.FormNoYear=YearNo
End If
If LostCount=Null Then
SysCount=doc.FormNoCount(0)
Elseif (LostCount>0)Then
SysCount=LostCount-1
Else
SysCount=doc.FormNoCount(0)
End If
If (doc.FormNoYear(0)=YearNo) Then
Else
Call YearListItem.AppendToTextList(Cstr(doc.FormNoYear(0)))
Call YearNoListItem.AppendToTextList(Cstr(doc.FormNoCount(0)))
SysCount=0
LostCount=0
doc.FormNoLost=0
End If
doc.FormNoYear=YearNo
If ComplieFormNo(SysMode,SysCount,varstring, FormNo)=True Then
If LostCount=Null Then
Call doc.replaceitemvalue(FormNo_Count,SysCount+1)
Elseif (LostCount>0)Then
If Ubound(doc.FormNoLost)>0 Then
Dim kk%
Dim i%
Dim NewLostNo()
kk=0
Redim NewLostNo(kk)
For i=1 To Ubound(doc.FormNoLost)
Redim Preserve NewLostNo(kk)
NewLostNo(kk)=doc.FormNoLost(i)
kk=kk+1
Next
doc.FormNoLost=NewLostNo
Else
doc.FormNoLost=0
End If
Else
Call doc.replaceitemvalue(FormNo_Count,SysCount+1)
End If
End If
Call doc.replaceitemvalue(FormNo_Status,FormNo_Idle)
If doc.save(False,False)=False Then
Exit Function
End If
If FormNo="" Then Exit Function
GetFormNo=FormNo
resumenext:
Exit Function
errl:
If Not(doc Is Nothing) Then
Call doc.replaceitemvalue(FormNo_Status,FormNo_Idle)
Call doc.save(False,False)
End If
Msgbox "建立表單編號錯誤!" & Chr(13) & " 系統錯誤訊息:" & Error$,64,"表單編號"
Resume resumenext
End Function
-----------------------------------------------------------------------------
Function GetServerDate() As String
'獲取伺服器之時間
Dim se As New NotesSession
Dim hdb As NotesDatabase
Dim hDoc As NotesDocument
Dim ServerDate As Variant
Set hDb=se.CurrentDatabase
Set hDoc=hDb.CreateDocument
If hDoc Is Nothing Then
ServerDate=Null
Else
ServerDate=hDoc.Created
Call hDoc.Remove(True)
End If
GetServerDate=Format(ServerDate,"yyyy/mm/dd hh:mm:ss AM/PM")
End Function
-----------------------------------------------------------------------------
4. 開啟資料庫之ACL,並新增一SystemAdmin角色,可將有權限建立編號定義文件之人員設定具有[SystemAdmin]角色,Default User一定要設為編輯者權限。
5. 最後,只要建立測試套表即可開始測試文件編號囉!!

6. 其他相關說明如下:
編號格式設定說明:
a.$YYYY$:表示出現四位數之世紀年,例:2003
b.$YY$:表示出現二位數之世紀年,例:03
c.$STRING$:表示可以加入一字串替代$STRING$所在之位置,呼叫產生編號Function時指定該字串值.
d.%NNN...NNN%:表示欲產生之數字格式,N的個數即代表位數,不足之位數,系統會自動補零.
e.%N%:可依實際數字大小呈現,系統不會自動補零.
f.格式字串範例:
部門公告-$YYYY$-%NNNN%
$STRING$-$YY$-%N%
$YYYY$-%NNN%
g.候補編號值欄位可輸入欲候補之號碼,多個數值請以逗號( , )分隔.
h.在Notes Script程式之使用方法:
i.請先將本資料庫內的 [ FormNo ] Script程式庫複製到欲使用自動編碼的應用程式資料庫的Script程式庫內.
ii.在Script程式的(Options)事件中,輸入Use "FormNo" 之程式,使系統可以載入[ FormNo ] Script程式庫之程式.
iii.在程式中呼叫 [ GetFormNo] Funcion並傳入各參數即可獲得新的表單編號.
Function GetFormNo(Byval FormNoDBPath As String,Byval FormNoType As String, Byval varstring As String) As String
參數說明:
FormNoDBPath ==>表單編號管理資料庫所在之資料庫路徑
FormNoType ==>表單編號名稱
varstring ==> 如果表單編號格式內含有$STRING$字串且varstring不為空值,則$STRING$字串會由varstring取代
d.下列為使用按鈕呼叫並回寫回欄位之範例:
Use "FormNo"
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim No As String
Set uidoc=ws.CurrentDocument
No=GetFormNo("test\formno.nsf","ISO文件編號"," ISO9001")
Messagebox "ISO文件編號為: " & No
Call uidoc.FieldSetText("ISONo",No)
End Sub
範例程式下載: |