-要將mail的設計文件主套表信件(_M) | Memo
'//Attach (Action) Click
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim docMail As NotesDocument
Dim docMailNew As NotesDocument
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim viewMail As NotesView
Dim docTmp As NotesDocument
Dim itemAuthor As NotesItem
Dim strFN_Subject As String
Dim strFN__UNID As String
Set db=session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Set viewMail = db.GetView("viewMemoByID")
strFN_Subject = "MailSubject"
strFN_UNID = "MailNoteID_1"
'=====check name.nsf============
Dim dbEmp As NotesDatabase
Dim docEmp As NotesDocument
Dim viewEmp As NotesView
Dim strMailServer As String
Dim strMailfile As String
Set dbEmp = New NotesDatabase( "CMOS05/CHIPMOS", "names.nsf" )
Set viewEmp = dbEmp.GetView("View-Full Name")
Set docEmp = viewEmp.GetDocumentByKey(session.CommonUserName )
If Not docEmp Is Nothing Then
strMailServer = docEmp.mailserver(0)
strMailfile = docEmp.mailfile(0)
Messagebox "開啟"+session.CommonUserName+"信箱；"+"Mailserver："+strMailServer+"；Mailfile："+strMailfile,mb_OK+MB_ICONINFORMATION,db.Title
Else
Messagebox "找不到"+session.CommonUserName+"的信箱",mb_OK+MB_ICONINFORMATION,db.Title
Exit Sub
End If
'======================
Dim strFloderName As String
Dim varResult As Variant
Dim aryOption(0 To 2) As String
aryOption(0) = "全部文件"
aryOption(1) = "信箱"
aryOption(2) = "寄件備份"
varResult = ws.Prompt(PROMPT_OKCANCELLIST,"選擇資料夾","選擇資料夾",aryOption(0),aryOption)
If Isempty(varResult) Then
Exit Sub
Else
Select Case varResult
Case "信箱"
strFloderName = "$Inbox"
Case "寄件備份"
strFloderName = "$Sent"
Case Else
strFloderName = "($All)"
End Select
End If
Set dc = ws.PickListCollection(1, False, _
strMailServer,strMailFile,strFloderName,"Attach Mail", _
"Please select a mail document.")
Set docMail = dc.GetFirstDocument
If docMail Is Nothing Then
Exit Sub
End If
Messagebox "你要貼入的 Mail 主旨: " + Cstr(docMail.Subject(0)),MB_OK+MB_ICONINFORMATION,db.title
Set docMailNew = New NotesDocument (db)
Set itemAuthor = New NotesItem(docMailNew,"DocAuthors",session.UserName ,AUTHORS)
Call docMailNew.save(True,False)
Call docMail.CopyAllItems (docMailNew)
docMailNew.Form = "Memo"
Call docMailNew.RemoveItem ("SysMoved")
'Forall m In docMail.Items
' If Ucase(m.name) <> "FORM" And Left(Ucase(m.name),1) <> "$" And Ucase(m.name) <> "SYSMOVED" Then
' Call m.copyitemtodocument(docMailNew,m.name)
' End If
'End Forall
Call docMailNew.save(True,False)
Label_Save:
If doc.QRA_DocumentID(0) = "" Then
Call uidoc.save
Goto Label_Save
End If
docMailNew.ParentDocUNID = doc.QRA_DocumentID(0)
docMailNew.Mail_UniversalID = docMailNew.UniversalID
Call docMailNew.save(True,False)
Call viewMail.Refresh
Set docTmp = viewMail.GetDocumentByKey (docMailNew.Mail_UniversalID(0),True)
If docTmp Is Nothing Then
Messagebox "貼入Mail失敗!! 請重貼 !!",MB_OK+MB_ICONSTOP,db.Title
Exit Sub
End If
Dim itemMailSub As NotesItem
Dim itemMail_UNID As NotesItem
Dim intC As Integer
Set itemMailSub = doc.GetFirstItem (strFN_Subject)
Set itemMail_UNID = doc.GetFirstItem (strFN_UNID)
If doc.GetItemValue (strFN_Subject)(0) = "" Then
intC = 1
Else
intC = Ubound(doc.GetItemValue(strFN_Subject))+2
End If
strFormula = "@ReplaceSubstring(Subject;@NewLine;' ')"
varRes = Evaluate(strFormula,docMailNew)
Call itemMailSub.AppendToTextList (Cstr(intC) + ":" +varRes(0))
Call itemMail_UNID.AppendToTextList (docMailNew.Mail_UniversalID(0))
Call uidoc.RefreshHideFormulas
Call uidoc.refresh
Call uidoc.save
End Sub
'//Deattach (Action) Click
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim viewMemo As NotesView
Dim varMail As Variant
Dim varTmp As Variant
Dim docMail As NotesDocument
Dim aryMail_Subject() As String
Dim aryMail_UNID() As String
Dim strInx As String
Dim strFN_Subject As String
Dim strFN__UNID As String
strFN_Subject = "MailSubject"
strFN_UNID = "MailNoteID_1"
Set uidoc = ws.CurrentDocument
Set doc = uidoc.document
Set db = doc.ParentDatabase
Set viewMemo = db.GetView("viewMemoByID")
varMail = ws.Prompt(PROMPT_OKCANCELLIST, db.title, "請選擇你要閱讀的Mail" , "" ,doc.GetItemValue(strFN_Subject))
If Isempty(varMail) Then
Exit Sub
End If
varTmp = Split(varMail,":")
strInx = varTmp(0)
Redim aryMail_Subject(0)
Redim aryMail_UNID(0)
intC = 1
For i = 0 To Ubound(doc.GetItemValue(strFN_Subject))
If Cstr(i+1) = strInx Then
Call viewMemo.Refresh
Set docMail = viewMemo.GetDocumentByKey (doc.GetItemValue (strFN_UNID)(varTmp(0)-1),True)
docMail.sysMoved = "Y"
Call docMail.Save(True,False)
Else
If aryMail_Subject(0) <> "" Then
Redim Preserve aryMail_Subject(0 To Ubound(aryMail_Subject)+1)
Redim Preserve aryMail_UNID(0 To Ubound(aryMail_UNID)+1)
End If
intPos = Instr(doc.GetItemValue (strFN_Subject)(i),":")
aryMail_Subject(Ubound(aryMail_Subject)) = Cstr(intC) + ":" + Mid(doc.GetItemValue (strFN_Subject)(i),intPos+1)
aryMail_UNID(Ubound(aryMail_UNID)) = doc.GetItemValue (strFN_UNID)(i)
intC = intC + 1
End If
Next
Call doc.ReplaceItemValue(strFN_Subject, aryMail_Subject)
Call doc.replaceItemValue(strFN_UNID,aryMail_UNID)
Call uidoc.RefreshHideFormulas
Call uidoc.refresh
Call uidoc.save
End Sub
'//Read (Action) Click
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim viewMemo As NotesView
Dim varMail As Variant
Dim varTmp As Variant
Dim docMail As NotesDocument
Dim strFN_Subject As String
Dim strFN__UNID As String
strFN_Subject = "MailSubject"
strFN_UNID = "MailNoteID_1"
Set uidoc = ws.CurrentDocument
Set doc = uidoc.document
Set db = doc.ParentDatabase
Set viewMemo = db.GetView("viewMemoByID")
varMail = ws.Prompt(PROMPT_OKCANCELLIST, db.title, "請選擇你要閱讀的Mail" , "" ,doc.GetItemValue(strFN_Subject))
If Isempty(varMail) Then
Exit Sub
End If
varTmp = Split(varMail,":")
Set docMail = viewMemo.GetDocumentByKey (doc.GetItemValue (strFN_UNID)(varTmp(0)-1),True)
Call ws.EditDocument (False,docMail,True)
End Sub
沒有留言:
張貼留言