Lotus 技術點之導出

a) 導出到excel中

Sub Click(Source As Button)

Dim s As New notessession

Dim db As notesdatabase

Dim view As notesview

Dim dc As notesdocumentcollection

Dim doc As notesdocument

Dim vcols As Variant

Dim uvcols As Integer

Set db = s.currentdatabase

Set dc = db.unprocesseddocuments

Set view = db.getview("當前視圖的名稱 ")

uvcols=Ubound(view.columns)

Dim xlapp As Variant

Dim xlsheet As Variant

'創建一個Excel對象

Set xlapp=createobject("Excel.application")

xlapp.statusbar = "正在創建工作表，請稍等......"

xlapp.visible = True

'添加工作薄

xlapp.workbooks.add

xlapp.referencestyle = 2

Set xlsheet = xlapp.workbooks(1).worksheets(1)

'爲工作表命名

xlsheet.name = "notes export"

Dim rows As Integer

rows = 1

Dim cols As Integer

cols = 1

Dim maxcols As Integer

For x=0 To Ubound(view.columns)

xlapp.statusbar = "正在創建單元格，請稍等...... "

If view.columns(x).IsHidden = False Then

If view.columns(x).title<>"" Then

xlsheet.cells(rows,cols).value = view.columns(x).title

cols = cols + 1

End If

maxcols=cols-1

Set doc=dc.getfirstdocument

Dim fieldname As String

Dim fitem As notesitem

rows=2

cols=1

Do While Not(doc Is Nothing)

For x=0 To Ubound(view.columns)

xlapp.statusbar="正在從Notes中引入數據，請稍等......"

If view.columns(x).IsHidden=False Then

If view.columns(x).title<>"" Then

fieldname = view.columns(x).itemname

Set fitem = doc.getfirstitem(fieldname)

xlsheet.cells(rows, cols).value = fitem.text

cols = cols +1

End If

rows = rows+1

cols = 1

Set doc= dc.getnextdocument(doc)

Loop

%REM

xlApp.Row s("1:1").select

xlApp.Selection.Font.Bold=True

xlApp.Range(xls heet.cells(1,1),xlsheet.Cells(rows,maxcols)).Select

xlApp.Selection.Fon t.Name="Arial"

xlApp.Selection.Font.Size=9

xlApp.Selcetion.Col umns.Autofit

%END REM

With xlapp.worksheets(1)

.pagesetup.orientation = 2

.pagesetup.centerheader = "report _ confidential"

.pagesetup.rightfooter = "page &P" & Chr$(13) & "Date:&D"

.pagesetup.CenterFooter = ""

End With

xlapp.referencestyle = 1

xlapp.range("A1").Select

xlapp.statusbar = "數據導入完成。"

End Sub

b) 以表格形式導出

Sub Initialize

%REM

功能：導出內部數據到Excel中去

作者：xxx

最後修改時間：

%END REM

On Error Goto unknowErr

Dim session As New NotesSession

Dim db As NotesDatabase

Dim view As NotesView

Dim tempdoc As NotesDocument

Dim strTemp As String

Dim strPath As String

If session.CurrentDatabase.FilePath=session.CurrentDatabase.FileName Then

strPath=""

Else

strPath=Strleftback(session.CurrentDatabase.FilePath,session.CurrentDatabase.FileName)

End If

Set db=New NotesDatabase("",strPath & "db_StaffInformation.nsf")

Set view=db.GetView("hvpersonInfo")

Print {Content-disposition:attachment; filename=data.xls}

Print {<table border="1">}

Print {<tr>}

Print {<td>工號</td>}

Print {<td>姓名</td>}

Print {<td>性別</td>}

Print {<td>單位名稱</td>}

Print {<td>職位</td>}

Print {<td>辦公地點</td>}

Print {<td>辦公電話</td>}

Print {<td>移動電話</td>}

Print {<td>傳真</td>}

Print {<td>IP地址</td>}

Print {<td>郵政編碼</td>}

Print {<td>電子郵件</td>}

Print {<td>聯繫地址</td>}

Print {</tr>}

'填寫數據

Set tempDoc=view.GetFirstDocument

While Not tempDoc Is Nothing

Print {<tr>}

'工號

Print {<td >} & Cstr(tempDoc.EmployeeID(0)) & {</td>}

'姓名

Dim neibuName As NotesName

Set neibuName=New NotesName(tempDoc.myname(0))

Print {<td >} & neibuName.Common & {</td>}

Print {<td >} & tempDoc.Sex(0) & {</td>}

'工作單文

If neibuName.OrgUnit1<>"" Then

strTemp=neibuName.OrgUnit1

End If

If neibuName.OrgUnit2<>"" Then

strTemp=strTemp & "/" & neibuName.OrgUnit2

End If

If neibuName.OrgUnit3<>"" Then

strTemp=strTemp & "/" & neibuName.OrgUnit3

End If

If neibuName.OrgUnit4<>"" Then

strTemp=strTemp & "/" & neibuName.OrgUnit4

End If

Print {<td >} & strTemp & {</td>}

'職務

If tempDoc.JobTitle(0)="1" Then

strTemp="員工"

End If

If tempDoc.JobTitle(0)="2" Then

strTemp="業務主管"

End If

If tempDoc.JobTitle(0)="3" Then

strTemp="副經理"

End If

If tempDoc.JobTitle(0)="4" Then

strTemp="部門經理"

End If

If tempDoc.JobTitle(0)="5" Then

strTemp="分管領導"

End If

If tempDoc.JobTitle(0)="6" Then

strTemp="總經理"

End If

If tempDoc.JobTitle(0)="7" Then

strTemp="董事長"

End If

Print {<td >} & strTemp & {</td>}

Print {<td >} & tempDoc.Location(0) & {</td>}

Print {<td >} & tempDoc.OfficePhoneNumber(0) & {</td>}

Print {<td >} & tempDoc.CellPhoneNumber(0) & {</td>}

Print {<td >} & tempDoc.OfficeFAXPhoneNumber(0) & {</td>}

Print {<td >} & tempDoc.IP(0) & {</td>}

Print {<td >} & tempDoc.OfficeZIP(0) & {</td>}

Print {<td >} & tempDoc.InternetAddress(0) & {</td>}

Print {<td >} & tempDoc.OfficeStreetAddress(0) & {</td>}

Print {</tr>}

Set tempDoc=view.GetNextDocument(tempDoc)

Wend

Print {</table>}

Exit Sub

unknowErr:

Messagebox "錯誤行：" & Erl & "錯誤信息：" & Error

End Sub

c) BS環境下導出

Option Public
Use "sysFunctionScript"
Sub Initialize
Dim file_view As NotesView
Dim dept_view As NotesView
Dim dept_doc As NotesDocument
Dim role_view As NotesView
Dim role_doc As NotesDocument
Dim user_view As NotesView
Dim user_doc As NotesDocument
Dim i As Integer
Dim var_id As Variant
Dim str_id As String
Dim str_path As String
str_path=session.GetEnvironmentString("NotesProgram",true)
'
On Error Goto ef

REM 刪除,臨時生成的組織結構附件
Set file_view=cur_db.GetView("outFile_view")
If file_view.AllEntries.Count>0 Then
  Call file_view.AllEntries.RemoveAll(True)
End If

i=1
REM 導出部門
Set dept_view=cur_db.GetView("exportDept_View")
If dept_view.AllEntries.Count>0 Then ''存在部門
  DbPath$=str_path+"\"+Format(Cstr(Today()),"YYYY-MM-DD")+"組織結構.xls"
  fileName$=Format(Cstr(Today()),"YYYY-MM-DD")+"組織結構.xls"
  Set exapp=CreateObject("Excel.Application")
  exapp.visible=False
  Set exwk=exapp.workbooks.add
  Set exsh=exwk.worksheets("sheet1")
  exsh.Range("A1").Value = "部門ID"
  exsh.Range("B1").Value = "編號"
  exsh.Range("C1").Value = "部門代碼"
  exsh.Range("D1").Value = "部門名稱"
  exsh.Range("E1").Value = "直接上級部門全稱"
  Set dept_doc=dept_view.GetFirstDocument()
  While Not(dept_doc Is Nothing)
   i=i+1
   exsh.Range("A"+Cstr(i)).Value = "'"+Cstr(dept_doc.DID(0))
   exsh.Range("B"+Cstr(i)).Value = Cstr(dept_doc.DOrder(0))
   exsh.Range("C"+Cstr(i)).Value = Cstr(dept_doc.unitCode(0))
   exsh.Range("D"+Cstr(i)).Value =Cstr(dept_doc.DName(0))
  ' exsh.range("D"+Cstr(i)).WrapText=True   '單元格自動
   exsh.Range("E"+Cstr(i)).Value =Cstr(dept_doc.DFName(0))
   Set dept_doc=dept_view.GetNextDocument(dept_doc)
  Wend
      REM 導出職務
  Set role_view=cur_db.GetView("role_View")
  If role_view.AllEntries.Count>0 Then ''存在職務
   Set exsh=exwk.worksheets("sheet2")
   exsh.Range("A1").Value = "職位ID"
   exsh.Range("B1").Value = "編號"
   exsh.Range("C1").Value = "職務代碼"
   exsh.Range("D1").Value = "職務名稱"
   exsh.Range("E1").Value = "所在部門"

   Set role_doc=role_view.GetFirstDocument()
   i=1
   While Not(role_doc Is Nothing)
    i=i+1
    exsh.Range("A"+Cstr(i)).Value = "'"+Cstr(role_doc.RID(0))
    exsh.Range("B"+Cstr(i)).Value = Cstr(role_doc.ROrder(0))
    exsh.Range("C"+Cstr(i)).Value = Cstr(role_doc.roleCode(0))
    exsh.Range("D"+Cstr(i)).Value = Cstr(role_doc.RName(0))
    exsh.Range("E"+Cstr(i)).Value =Cstr(role_doc.RDName(0))
    Set role_doc=role_view.GetNextDocument(role_doc)
   Wend

   REM 導出人員
   Set user_view=cur_db.GetView("user_View")
   If user_view.AllEntries.Count>0 Then ''存在人員
    Set exsh=exwk.worksheets("sheet3")
    exsh.Range("A1").Value = "編號"
    exsh.Range("B1").Value = "工號"
    exsh.Range("C1").Value = "姓名"
    exsh.Range("D1").Value = "職位"
    exsh.Range("E1").Value = "默認密碼（不輸入默認：123456）"
    exsh.Range("F1").Value = "性別"
    exsh.Range("G1").Value = "郵件名（空值默認郵件爲姓名）"
    exsh.Range("H1").Value = "別名"
    exsh.Range("I1").Value = "interNet郵箱"
    exsh.Range("J1").Value = "第一級主管"
    exsh.Range("K1").Value = "第二級主管"
    exsh.Range("L1").Value = "第三級主管"
    exsh.Range("M1").Value = "第四級主管"
    Set user_doc=user_view.GetFirstDocument()
    i=1
    While Not(user_doc Is Nothing)
     i=i+1
     exsh.Range("A"+Cstr(i)).Value = Cstr(user_doc.UOrder(0))
     exsh.Range("B"+Cstr(i)).Value = "'"+ Cstr(user_doc.UNumber(0))
     exsh.Range("C"+Cstr(i)).Value = Cstr(user_doc.UName(0))
     exsh.Range("D"+Cstr(i)).Value =Cstr(user_doc.URName(0))
     exsh.Range("E"+Cstr(i)).Value =Cstr("123456")
     exsh.Range("F"+Cstr(i)).Value =Cstr(user_doc.USex(0))
     exsh.Range("G"+Cstr(i)).Value =Cstr(user_doc.UMail(0))
     exsh.Range("H"+Cstr(i)).Value = "'"+Cstr(user_doc.UBName(0))
     exsh.Range("I"+Cstr(i)).Value =Cstr(user_doc.Uimail(0))

     str_id=""
     If user_doc.UManagerUnid1(0)<>"" Then
      var_id=Split(user_doc.UManagerUnid1(0),",")
      For a=0 To UBound(var_id)
       If strleft(var_id(a),1)="D" Then
        str_id=str_id+","+funSystemGetDeptNameByDeptID(var_id(a))
       Else
        If StrLeft(var_id(a),1)="R" Then
         str_id=str_id+","+funSystemGetRoleNameByRoleID(var_id(a))
        Else
         str_id=str_id+","+StrRight(var_id(a),"P")
        End If
       End If
      Next
     End If
     exsh.Range("J"+Cstr(i)).Value =StrRight(str_id,",")
     str_id=""
     If user_doc.UManagerUnid2(0)<>"" Then
      var_id=Split(user_doc.UManagerUnid2(0),",")
      For a=0 To UBound(var_id)
       If StrLeft(var_id(a),1)="D" Then
        str_id=str_id+","+funSystemGetDeptNameByDeptID(var_id(a))
       Else
        If StrLeft(var_id(a),1)="R" Then
         str_id=str_id+","+funSystemGetRoleNameByRoleID(var_id(a))
        Else
         str_id=str_id+","+StrRight(var_id(a),"P")
        End If
       End If
      Next
     End If
     exsh.Range("K"+Cstr(i)).Value =StrRight(str_id,",")
     str_id=""
     If user_doc.UManagerUnid3(0)<>"" Then
      var_id=Split(user_doc.UManagerUnid3(0),",")
      For a=0 To UBound(var_id)
       If StrLeft(var_id(a),1)="D" Then
        str_id=str_id+","+funSystemGetDeptNameByDeptID(var_id(a))
       Else
        If StrLeft(var_id(a),1)="R" Then
         str_id=str_id+","+funSystemGetRoleNameByRoleID(var_id(a))
        Else
         str_id=str_id+","+StrRight(var_id(a),"P")
        End If
       End If
      Next
     End If
     exsh.Range("L"+Cstr(i)).Value =StrRight(str_id,",")
     str_id=""
     If user_doc.UManagerUnid4(0)<>"" Then
      var_id=Split(user_doc.UManagerUnid4(0),",")
      For a=0 To UBound(var_id)
      ' print var_id(a)+"--"+StrLeft(var_id(a),1)

       If StrLeft(var_id(a),1)="D" Then
        str_id=str_id+","+funSystemGetDeptNameByDeptID(var_id(a))
       Else
        If StrLeft(var_id(a),1)="R" Then
         str_id=str_id+","+funSystemGetRoleNameByRoleID(var_id(a))
        Else
         str_id=str_id+","+StrRight(var_id(a),"P")
        End If
       End If
      Next
     End If
     exsh.Range("M"+Cstr(i)).Value =StrRight(str_id,",")

     Set user_doc=user_view.GetNextDocument(user_doc)
    Wend
   End If
  End If
  exwk.SaveAs(DbPath$)
  Dim ftpItem As NotesRichTextItem          '放到附件裏
  Dim ftpOBJ As NotesEmbeddedObject
  Dim ftpDoc As NotesDocument
  Dim item As NotesItem
  Set ftpDoc=cur_db.CreateDocument

  keyWord$=Cstr(Now())
  ftpDoc.form="outFile_Form" ''表單名
  ftpDoc.keyWord=keyWord$ ''打開關鍵字
  ftpDoc.writer="*"
  Set item=ftpDoc.GetFirstItem("writer")
  item.IsAuthors=True
  Set ftpItem=New NotesRichTextItem(ftpDoc,"body")
  Set ftpOBJ=ftpItem.EmbedObject(EMBED_ATTACHMENT,"",DbPath$)
  Call ftpDoc.Save(True,False)
  exapp.quit
  Set exapp=Nothing
  Kill DbPath$
  filePath$="/"+Strleft(cur_db.FilePath,"\")+"/sysZZJG.nsf/outFile_view/"+ftpDoc.UniversalID+"/$FILE/"+fileName$

  Set file_view=Nothing
  Set dept_view=Nothing
  Set dept_doc=Nothing
  Set role_view=Nothing
  Set role_doc=Nothing
  Set user_view=Nothing
  Set user_doc=Nothing

  Print |<script language="javascript">|
  Print |window.location="|+filePath$+|"|
  Print |</script>|
End If

Exit Sub
ef:
Msgbox "【導出組織機構)|(exportUnit_Agent】"& Error$ & " at line " & Cstr(Erl)
Exit Sub
End Sub

Lotus 技術點之導出

微服務實踐k8s&dapr開發部署實驗（2）狀態管理

Win10 LTSC 2019 安裝後的一些步驟

Python 潮流週刊#52：Python 處理 Excel 的資源

IBM / Lotus Domino 與 WebSphere Portal: 單點登錄

LDAP基本概念

理解 IBM Lotus Domino 郵件數據庫的限額

Notes與SAP數據的互換

適於 IBM Lotus Domino 開發人員的 IBM WebSphere portlet 開發

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結