guanxf

我的博客:http://blog.sina.com.cn/17learning

  BlogJava :: 首页 :: 新随笔 :: 联系 :: 聚合  :: 管理 ::
  71 随笔 :: 1 文章 :: 41 评论 :: 0 Trackbacks
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="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">|
     data = data + |<soap:Body>|
     data = data+|<sendMessageToNextPerson xmlns="http://www.chinatelecom.com.cn/schema/ctcc/common/v2_1">|
     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","http://Ip:5080/isag/North/SMS/SendSms"
     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
posted on 2011-12-29 17:59 管先飞 阅读(336) 评论(0)  编辑  收藏 所属分类: Lotus Notes

只有注册用户登录后才能发表评论。


网站导航: