Exchange-2003

推送聯繫人交換使用者

  • January 12, 2014

我正在使用 Exchange 2003、Outlook 2007/2003。有沒有辦法將一組聯繫人推送給使用者？我寧願不使用 GAL，而且我真的不想發送 csv 文件讓他們導入。

任何幫助表示讚賞。

編輯：

如果有人有很好的方法來管理與移動員工的聯繫，我也很想听聽。

這是我一直用來將聯繫人的子文件夾從一個使用者推送到文本文件中提供的使用者列表中的一個極其損壞的 vbscript：

snServername = "exchange"
mnMailboxname = "user.to.copy.from"
mndestmailbox = ""

Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
   ("c:\scripts\users.txt", ForReading)
Do Until objTextFile.AtEndOfStream
   mndestmailbox = objTextFile.Readline

   wscript.echo ""
   wscript.echo mndestmailbox


SourceURL = "http://" & snServername & "/exchange/" & mnMailboxname & "/contacts/folder to copy/"
DestinURL = "http://" & snServername & "/exchange/" & mndestmailbox & "/contacts/folder to copy/"
set req = createobject("microsoft.xmlhttp")

set CDOSession = CreateObject("MAPI.Session")
strProfile = snServername & vbLf & mnMailboxname
CDOSession.Logon "",,, False,, True, strProfile
set RDOSession = CreateObject("Redemption.RDOSession")
RDOSession.MAPIOBJECT = CDOSession.MAPIOBJECT
set cfCalendarFolder1 = RDOSession.GetSharedDefaultFolder(mndestmailbox, 10)
For Each fld In cfCalendarFolder1.Folders
   If fld.name = "folder to copy" Then 
       Set cfCalendarFolder = fld 
   End if
next

colbblob = Collabblobget()
wscript.echo colbblob
QueryMailbox(colbblob)

wscript.echo "Done"

Loop


Sub QueryMailbox(colbblob)

strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" xmlns:R=""http://schemas.microsoft.com/repl/""><R:repl><R:collblob>" & colbblob & "</R:collblob></R:repl>"
strQuery = strQuery & "<D:sql>SELECT ""DAV:href"", ""urn:schemas:httpmail:subject"", ""http://schemas.microsoft.com/mapi/proptag/x0fff0102"",""http://schemas.microsoft.com/repl/repl-uid"" "
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & SourceURL & """') Where NOT ""urn:schemas:calendar:instancetype"" = 2 AND NOT ""urn:schemas:calendar:instancetype"" = 3 AND ""DAV:ishidden"" = False AND ""DAV:isfolder"" = False "
strQuery = strQuery & "</D:sql></D:searchrequest>"
req.open "SEARCH", SourceURL, false, "", ""
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
  wscript.echo "Status: " & req.status
  wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
  wscript.echo "Status: " & req.status
  wscript.echo "Status text:  " & req.statustext
  set oResponseDoc = req.responseXML
  set oNodeList = oResponseDoc.getElementsByTagName("d:collblob")
  For i = 0 To (oNodeList.length -1)
   set oNode = oNodeList.nextNode
       colblob =  oNode.Text
   Collabblobset(colblob)
  Next
  set idNodeList = oResponseDoc.getElementsByTagName("f:x0fff0102")
  set replidNodeList = oResponseDoc.getElementsByTagName("d:repl-uid")
  set replchangeType = oResponseDoc.getElementsByTagName("d:changetype")
  for id = 0 To (idNodeList.length -1)
   set oNode1 = idNodeList.nextNode
   set oNode2 = replidNodeList.nextNode
   set oNode3 = replchangeType.nextNode
   select case oNode3.text
       case "new" call Copyapt(Octenttohex(oNode1.nodeTypedValue),oNode2.text)
       case "delete" wscript.echo oNode3.text
                 wscript.echo oNode2.text
                 DeleteContact(oNode2.text)
       case "change" Wscript.echo "Change"
                 call DeleteContact(oNode2.text)
                 call Copyapt(Octenttohex(oNode1.nodeTypedValue),oNode2.text)
   end select
  next
Else
  wscript.echo "Status: " & req.status
  wscript.echo "Status text: " & req.statustext
  wscript.echo "Response text: " & req.responsetext
End If

End Sub

function Collabblobget()

xmlreqtxt = "<?xml version='1.0'?><a:propfind xmlns:a='DAV:' xmlns:cp='" & SourceURL & "'><a:prop><cp:collblob/></a:prop></a:propfind>"
req.open "PROPFIND", DestinURL, false, "", ""
req.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
req.setRequestHeader "Depth", "0"
req.setRequestHeader "Translate", "f"
req.send xmlreqtxt
set oResponseDoc = req.responseXML
set oCobNode = oResponseDoc.getElementsByTagName("d:collblob")
For i1 = 0 To (oCobNode.length -1)
  set oNode = oCobNode.nextNode
  Collabblobget = oNode.Text   
Next

End function

Sub Collabblobset(colblob)
xmlstr = "<?xml version=""1.0""?>" _
& "<g:propertyupdate " _
& "    xmlns:g=""DAV:"" xmlns:e=""http://schemas.microsoft.com/exchange/""" _ 
& "    xmlns:dt=""urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"" " _
& "    xmlns:cp=""" & SourceURL & """ " _
& "    xmlns:header=""urn:schemas:mailheader:"" " _
& "    xmlns:mail=""urn:schemas:httpmail:"">  " _
& "    <g:set>  " _
& "        <g:prop>  " _
& "            <cp:collblob>" & colblob & "</cp:collblob>  " _
& "        </g:prop>  " _
& "    </g:set>  " _ 
& "</g:propertyupdate>" 

req.open "PROPPATCH", DestinURL, False
req.setRequestHeader "Content-Type", "text/xml;"
req.setRequestHeader "Translate", "f"
req.setRequestHeader "Content-Length:", Len(xmlstr)
req.send(xmlstr)


end sub

Sub CopyApt(messageEntryID,ReplID)
set objapt = CDOSession.GetMessage(messageEntryID)
set objCopyapt = objapt.copyto(cfCalendarFolder.EntryID)
objCopyapt.Unread = false
objCopyapt.Fields.Add "0x8542", vbString, ReplID,"0820060000000000C000000000000046"
objCopyapt.Update
Set objCopyapt = Nothing
wscript.echo objapt.subject

end Sub

Sub CopyContact(messageEntryID,ReplID)
set objcontact = objSession.getmessage(messageEntryID)
set objCopyContact = objcontact.copyto(pfPublicFolderID,objpubstore.ID)
objCopyContact.Unread = false
objCopyContact.Fields.Add "0x8542", vbString, ReplID,"0820060000000000C000000000000046"
objCopyContact.Update
Set objCopyContact = Nothing
wscript.echo objcontact.subject

end Sub

Sub DeleteContact(replUID)

strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"">"
strQuery = strQuery & "<D:sql>SELECT ""DAV:Displayname"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & DestinURL & """') Where ""http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/0x8542"" = '" & replUID & "' AND ""DAV:isfolder"" = False "
strQuery = strQuery & "</D:sql></D:searchrequest>"
req.open "SEARCH", DestinURL, false
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
req.send strQuery
wscript.echo req.responsetext
If req.status >= 500 Then
  wscript.echo "Status: " & req.status
  wscript.echo "Status text: An error occurred on the server."
ElseIf req.status = 207 Then
  wscript.echo "Status: " & req.status
  wscript.echo "Status text:  " & req.statustext
  set oResponseDoc = req.responseXML
  set oNodeList = oResponseDoc.getElementsByTagName("a:href")
  For i = 0 To (oNodeList.length -1)
   set oNode = oNodeList.nextNode
   wscript.echo oNode.text
   req.open "DELETE", oNode.text, false
   req.send 
   wscript.echo "Status: " & req.status
  Next
Else
  wscript.echo "Status: " & req.status
  wscript.echo "Status text: " & req.statustext
  wscript.echo "Response text: " & req.responsetext
End If

end Sub


Function Octenttohex(OctenArry)  
 ReDim aOut(UBound(OctenArry)) 
 For i = 1 to UBound(OctenArry) + 1 
   if len(hex(ascb(midb(OctenArry,i,1)))) = 1 then 
       aOut(i-1) = "0" & hex(ascb(midb(OctenArry,i,1)))
   else
   aOut(i-1) = hex(ascb(midb(OctenArry,i,1)))
   end if
 Next 
 Octenttohex = join(aOUt,"")
End Function

我不記得我在哪裡找到了初始腳本，但如果我找到了，我會發布。我認為這個只能在 Exchange 2003 上工作。另外，要使其正常工作，使用者必須folder to copy已經在正確的位置（但為空）。

引用自：https://serverfault.com/questions/41137

相關問答

Active-Directory

發送給使用者的會議邀請也被發送給組使用者

  • July 3, 2011
檢視問答
Outlook

Outlook 日曆附件僅對必需的與會者進行有限訪問

  • March 11, 2011
檢視問答
Windows-Server-2003

按組策略禁用 Outlook 簽名

  • February 24, 2011
檢視問答
Windows-Server-2003

Exchange 2003 如何設置全球聯繫人列表？

  • October 14, 2010
檢視問答
Exchange

有沒有辦法從非預設日曆發送 Outlook 會議請求？

  • April 6, 2010
檢視問答
Exchange-2003

Exchange 2003 對在伺服器上儲存發送的項目有一些限制嗎？

  • February 5, 2010
檢視問答