ตัวอย่าง LotusScript ที่รันครับ
Dim Session As New NotesSession
Dim Db As NotesDatabase
Dim Profiledoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim View As NotesView
Dim theAgent As NotesAgent
Dim Datetime As New NotesDateTime(Today)
Dim SenderName As String
Dim CheckDay As String
ErrCount = 0
Set Db = Session.CurrentDatabase
Set theAgent = Session.CurrentAgent
Set View = Db.GetView("(Parameter)")
Set Profiledoc = View.GetFirstDocument()
On Error Goto ErrorAttach
' ---------------------------- Beginning Log ----------------------------
Do While Not Profiledoc Is Nothing
Set Doc= New NotesDocument ( db )
Doc.Form = "SendReceive"
Doc.SendName = Profiledoc.SendName
Doc.HospitalCode = Profiledoc.HospitalCode
Doc.FilePath = Profiledoc.FilePath
Doc.FileName = Profiledoc.FileName
Doc.ExtractFilePath = Profiledoc.ExtractFilePath
Doc.ExtractFileName = Profiledoc.ExtractFileName
Doc.Owner = Profiledoc.SendName
Doc.Author = Profiledoc.SendName
Doc.Status = "1"
Doc.DateCreate = Now()
FilePath = Profiledoc.FilePath(0)
LogName = Profiledoc.LogFileName(0)
Dim SendName As New NotesName(Doc.SendName(0))
SenderName = SendName.Abbreviated
If LogName = "" Then
Messagebox "กรุณาใส่ชื่อของ Log ไฟล์ในเอกสารหลักก่อน run Agent ", 0+16, "ผิดพลาด"
Exit Sub
End If
If CheckLogFiles(FilePath, LogName) = "No" Then
Goto SkipLogFiles
End If
Set rtitem = New NotesRichTextItem( Doc, "AttFile" )
Set Object = rtitem.EmbedObject( EMBED_ATTACHMENT,"",Doc.filepath(0) & "\" & Doc.filename(0))
Call Doc.Save( True, True )
SkipLogFiles:
Set Profiledoc = View.GetNextDocument(Profiledoc)
Loop
If ErrCount > 0 Then
Msgbox "Some document cannot create an attachment" & Chr(13) &_
" May be file are missing" & Chr(13) & " Please see ' Error in Creating Attachment ' "
End If
Exit Sub
ErrorAttach:
Print "Error " & Str(Err) & " : " & Error$
Resume Next
End Sub
Function CheckLogFiles(FilePath, LogName) As String
Dim txt As String
Dim fileNum As Integer
Dim arrayOfRecs() As RecType
fileNum% = Freefile()
On Error Goto ErrorOpenFile
FileName$ = FilePath & "\" & LogName
Open FileName$ For Input As fileNum%
Seek fileNum%, 1
Redim arrayOfRecs(1)
If Not Eof(fileNum%) Then
Input #fileNum%, arrayOfRecs(1).Status$
If Ucase(arrayOfRecs(1).Status$) = "COMPLETE TRANSFER" Or Ucase(arrayOfRecs(1).Status$) = "TRANSFER COMPLETE" Then
Close #fileNum%
Reset
Open fileName$ For Output As fileNum%
Write #fileNum%, "Wait for Transfer"
CheckLogFiles = "Yes"
Else
Close #fileNum%
Reset
Open fileName$ For Output As fileNum%
Write #fileNum%, "Wait for Transfer"
CheckLogFiles = "No"
End If
Else
Close #fileNum%
Reset
Open fileName$ For Output As fileNum%
Write #fileNum%, "Wait for Transfer"
CheckLogFiles = "No"
End If
Close #fileNum%
Reset
Exit Function
ErrorOpenFile:
' Msgbox "Error" & Err & " : " & Error$
Open fileName$ For Output As fileNum%
Write #fileNum%, "Wait for Transfer"
CheckLogFiles = "No"
Close #fileNum%
Reset
Exit Function
End Function
:yellow_cool.gif: |