Sub Initialize
On Error Goto errormsg
Dim session As New notessession
Dim cdoc As notesdocument
Dim doc As notesdocument
Dim view As notesview
Dim db As notesdatabase
Dim db_user As NotesDatabase
Set db=session.currentdatabase
Set cdoc=session.documentcontext
Dim mdoc As NotesDocument
cdocUnid = cdoc.UniversalID
Set db_user = session.GetDatabase(db.Server,"sctel\lyuser.nsf")
NotesMacro$ =
|@AttachmentNames|
attList = Evaluate(NotesMacro$,cdoc)
attNames = ""
For i = Lbound(attList) To Ubound(attList)
If Trim(attList(i))<> "" Then
If attNames = "" Then
attNames = attList(i)
Else
attNames = attNames + "," + attList(i)
End If
End If
Next
Set view=db.getview("SMS_showFile")
For i=0 To Ubound(cdoc.alldeptName)
If Len(Trim(cdoc.alldeptName(i)))>0 Then
key=cdocUnid+cdoc.alldeptName(i)
Msgbox "key;"+key
Set dc=view.getalldocumentsbykey(key,True)
Msgbox "dc.count:"+Cstr(dc.count)
If dc.count>0 Then
Set doc=dc.getfirstdocument
Else
Set doc = New NotesDocument(db)
Dim authorsItem As New NotesItem(doc, "Author", _
"admin", Readers)
Dim readersItem As New NotesItem(doc, "yhuser", _
Trim(cdoc.alldeptName(i)), Authors)
End If
doc.HYUNID=cdocUnid
doc.SMS_Subject=cdoc.SMS_Subject(0)
'根據人員取出部門，部門編號
Set view_user = db_user.GetView("viewShowfileByUserName")
Set doc_user = view_user.GetDocumentByKey(cdoc.alldeptName(i),True)
If Not doc_user Is Nothing Then
doc.TypeNum = doc_user.TypeNum(0)
Set view_dept = db_user.GetView("viewDeptByNum")
Set doc_dept = view_dept.getdocumentbykey(doc_user.TypeNum(0),True)
If Not doc_dept Is Nothing Then
doc.TypeName = doc_dept.Type(0)
doc.deptNa = doc_dept.Type(0)
End If
End If
Call doc.save(True,True)'存儲
Dim SendTo(1) As String
SendTo(0) = cdoc.alldeptName(i)
Call sendMessge(SendTo)
End If
Next
cdoc.htmls="消息已經發送！"
'doc.SMS_riqi=Evaluate("@Created") '重新創建時間
Call cdoc.save(True,True)'存儲
cdoc.htmls="<script>alert('發送成功！');</script>"
Exit Sub
errormsg:
Msgbox "save Error:" & Str(Erl) & " " & Error
End Sub
Sub sendMessge(SendTo As Variant)
On Error Goto processError
Dim session As New notessession
Set db=session.currentdatabase
Set cdoc=session.documentcontext
Dim doc As NotesDocument
Dim view As NotesView
Dim UserDB As NotesDatabase
Dim tel As String
Dim content As String
query = cdoc.Query_String_Decoded(0)
Dim smsitem As NotesItem
Set smsitem =cdoc.GetFirstItem("SMS_Body")
content="您好！請即時處理委機關辦公系統中的《"+cdoc.foldername(0)+":"+smsitem.Text+"》文件，謝謝！["+cdoc.PUser(0)+"]"
'Msgbox"短信內容:"+content
Dim i,j As Integer
i = 0
Set UserDB = session.GetDatabase("","sctel/lyuser.nsf")
Set view = UserDB.GetView( "cellPhoneByUser" )
content=Replace(content,">","＞")
content=Replace(content,"<","＜")
Forall p In SendTo
If p <> "" Then
'獲取處理人號碼
Set doc = view.GetDocumentByKey (p)
If Not (doc Is Nothing) Then
tel=doc.CellPhoneNumber(0)
'Msgbox "tel--->"+tel
If tel <> "" Then
Msgbox "開始測試短信"
Dim xmlhttp As Variant
Dim data, URL As String
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
data = |<?xml version="1.0" encoding="utf-8"?>|
data = data + |<soap:Envelope xmlns:xsi="
data = data + |<soap:Body>|
data = data+|<sendMessageToNextPerson xmlns="
data = data +|<senderaddr>|+Trim(tel)+|</senderaddr>|
data = data + |<content>|+content+|</content>|
data = data + |</sendMessageToNextPerson>|
data = data + |</soap:Body>|
data = data +|</soap:Envelope>|
URL="
http://localhost:82/sendSMS/gzwSendSM.asmx?op=sendMessageToNextPerson"
xmlhttp.Open "POST",url, False
xmlhttp.SetRequestHeader "Content-Type", "text/xml; charset=utf-8"
xmlhttp.SetRequestHeader "Content-Length", "length"
xmlhttp.SetRequestHeader "SOAPAction","
xmlhttp.Send(data)
Else
Msgbox "未找到號碼"
End If
Else
Messagebox "未找到號碼"
End If
End If
End Forall
Exit Sub
processError:
Dim sTemp As String
sTemp = "ini出錯行:" + Cstr(Erl()) + " 出錯信息:" + Error() + " 請與管理員聯系!"
Print |<script>alert("|+sTemp+|")</script>|
Exit Sub
End Sub