This script searches through the user mailboxes in a single organization unit (OU), connects to them with WebDav, then searches through their contacts and replaces up to 10 specified numbers (for varying formats) with a single new number. When you modify this script, you need to modify the Exchange server path, the OU Path, and the telephone numbers in the middle of the script.

To understand the contact fields in WebDav I used:

• MS KB Article 296126
• MSDN Article on Getting Item Property Values (WebDAV)

I apologize if not all my variables are declared, but since it works, I am too lazy to go back through it and turn on Option Explicit.

I figured this would be a good starting point for anyone looking to use WebDAV to modify any items in user mailboxes programatically.

Script Code:

'RUN THIS SCRIPT USING CSCRIPT
'
'If you name this script export.vbs an example to run it from
'the command prompt would be:
'   cscript export.vbs > log.txt
'
'Contact Fields taken from: http://support.microsoft.com/kb/296126
'Other WebDAV info http://msdn2.microsoft.com/en-us/library/ms992620.aspx
Dim sOUPath, Usr, Pwd

sOUPath = InputBox("Enter the OU Path:", "Contact Phone Number Changer", _
          "LDAP://exchangedomain/ou=Users,ou=Customer,dc=exchangedomain,dc=com")

Set oOU = GetObject(sOUPath)

Usr = InputBox("Enter the Username:", "Contact Phone Number Changer", _
      "exchangedomain\accountwithfullmailboxaccesstoallaccounts")

Pwd = InputBox("Enter the Password:", "Contact Phone Number Changer", "")

SearchOU oOU, "http://ENTEREXCHANGESERVERHERE/exchange/", Usr, Pwd

Wscript.Echo "Complete"

Sub SearchContacts (sURL, sUsername, sPassword)

  WScript.Echo sURL
  Dim objX, strR, objXD, objDE
  Set objX = CreateObject("Microsoft.XMLHTTP")
  objX.Open "PROPFIND", sURL, FALSE, sUsername, sPassword

  strXMLNSInfo = "xmlns:d=""DAV:"" " & _
        "xmlns:c=""urn:schemas:contacts:"" " & _
        "xmlns:e=""http://schemas.microsoft.com/exchange/"" " & _
        "xmlns:mapi=""http://schemas.microsoft.com/mapi/"" " & _
        "xmlns:x=""xml:"" xmlns:cal=""urn:schemas:calendar:"" " & _
        "xmlns:mail=""urn:schemas:httpmail:"">"

  strPhoneFields = "<"&"c:telephoneNumber/>" & _
                   "<"&"c:telephonenumber2/>" & _
                   "<"&"c:facsimiletelephonenumber/>" & _
                   "<"&"c:homePhone/>" & _
                   "<"&"c:homephone2/>" & _
                   "<"&"c:homefax/>" & _
                   "<"&"c:otherTelephone/>" & _
                   "<"&"c:otherfax/>" & _
                   "<"&"c:pager/>" & _
                   "<"&"c:mobile/>" & _
                   "<"&"c:othermobile/>" & _
                   "<"&"c:internationalisdnnumber/>" & _
                   "<"&"c:telexnumber/>" & _
                   "<"&"c:ttytddphone/>" & _
                   "<"&"c:callbackphone/>"

  strR = "<" & "?" & "xml version='1.0'?>" & _
         "<"&"d:propfind " & strXMLNSInfo 'xmlns:d='DAV:' xmlns:c='urn:schemas:contacts:'>" & _
         "<"&"d:prop><"&"d:displayname/>" & strPhoneFields & "<"&"/d:prop><"&"/d:propfind>"

  objX.SetRequestHeader "Content-type:", "text/xml"
  objX.SetRequestHeader "Depth", "1"
  objX.send(strR)

  set docback = objX.responseXML

  Dim objNodeList
  Set objNodeList = docback.getElementsByTagName("*")
  For i = 0 TO (objNodeList.length -1)
    Set objNode = objNodeList.nextNode
    select case objNode.NodeName
      case "a:href"
         UpdateContact URL, sUserName, sPassword, tel1, tel2, tel3, tel4, tel5, tel6, _
                       tel7, tel8, tel9, tel10, tel11, tel12, tel13, tel14, tel15
         URL   = objNode.Text
         tel1  = ""
         tel2  = ""
         tel3  = ""
         tel4  = ""
         tel5  = ""
         tel6  = ""
         tel7  = ""
         tel8  = ""
         tel9  = ""
         tel10 = ""
         tel11 = ""
         tel12 = ""
         tel13 = ""
         tel14 = ""
         tel15 = ""
      case "d:telephoneNumber"
         tel1  = objNode.Text
      case "d:telephonenumber2"
         tel2  = objNode.Text
      case "d:facsimiletelephonenumber"
         tel3  = objNode.Text
      case "d:homePhone"
         tel4  = objNode.Text
      case "d:homephone2"
         tel5  = objNode.Text
      case "d:homefax"
         tel6  = objNode.Text
      case "d:otherTelephone"
         tel7  = objNode.Text
      case "d:otherfax"
         tel8  = objNode.Text
      case "d:pager"
         tel9  = objNode.Text
      case "d:mobile"
         tel10 = objNode.Text
      case "d:othermobile"
         tel11 = objNode.Text
      case "d:internationalisdnnumber"
         tel12 = objNode.Text
      case "d:telexnumber"
         tel13 = objNode.Text
      case "d:ttytddphone"
         tel14 = objNode.Text
      case "d:callbackphone"
         tel15 = objNode.Text
    end select
 
    if objNode.NodeName = "a:href" then
      'Call Replace
      URL = objNode.Text
    end if
  Next

  UpdateContact URL, sUserName, sPassword, tel1, tel2, tel3, tel4, tel5, _
                tel6, tel7, tel8, tel9, tel10, tel11, tel12, tel13, tel14, _
                tel15
End Sub

Function MReplace(source, n, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
  t = REPLACE(source, o1, n)
  t = REPLACE(t, o2,  n)
  t = REPLACE(t, o3,  n)
  t = REPLACE(t, o4,  n)
  t = REPLACE(t, o5,  n)
  t = REPLACE(t, o6,  n)
  t = REPLACE(t, o7,  n)
  t = REPLACE(t, o8,  n)
  t = REPLACE(t, o9,  n)
  t = REPLACE(t, o10, n)
  MReplace = t
End Function

Sub UpdateContact (ContactURL, sUsername, sPassword, t1, t2, t3, t4, t5, t6, _
                   t7, t8, t9, t10, t11, t12, t13, t14, t15)

  'Do some major replacements, replace all the o fields with the new field
  tall = Trim(t1 & t2 & t3 & t4 & t5 & t6 & t7 & t8 & t9 & t10 & t11 & t12 & _
              t13 & t14 & t15)

'*******************************************************************************
'******************* OLD NUMBERS TO REPLACE
  o1  = "678-523-0248"
  o1  = "678-523-0248"
  o2  = "678-5230248"
  o3  = "6785230248"
  o4  = "(678)523-0248"
  o5  = "(678)5230248"
  o6  = "1-678-523-0248"
  o7  = "1-678-5230248"
  o8  = "1-6785230248"
  o9  = "1(678)523-0248"
  o10 = "1(678)5230248"
  tnew = "917-519-8171"
'*******************************************************************************

  tallnew  = Trim(MReplace(tall,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10))



  If Right(Ucase(ContactURL),4) = ".EML" AND tall <> tallnew then
  wscript.echo "TALL: " & tall & vbcrlf & "TALLNEW: " & tallnew

   t1  = MReplace(t1,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t2  = MReplace(t2,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t3  = MReplace(t3,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t4  = MReplace(t4,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t5  = MReplace(t5,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t6  = MReplace(t6,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t7  = MReplace(t7,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t8  = MReplace(t8,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t9  = MReplace(t9,  tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t10 = MReplace(t10, tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t11 = MReplace(t11, tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t12 = MReplace(t12, tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t13 = MReplace(t13, tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t14 = MReplace(t14, tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)
   t15 = MReplace(t15, tnew, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10)

   'Build Storage Data    
   if t1 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:telephoneNumber>"&t1&"<"&"/c:telephoneNumber>"
   if t2 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:telephonenumber2>"&t2&"<"&"/c:telephonenumber2>"
   if t3 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:facsimiletelephonenumber>"&t3&"<"&"/c:facsimiletelephonenumber>"
   if t4 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:homePhone>"&t4&"<"&"/c:homePhone>"
   if t5 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:homephone2>"&t5&"<"&"/c:homephone2>"
   if t6 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:homefax>"&t6&"<"&"/c:homefax>"
   if t7 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:otherTelephone>"&t7&"<"&"/c:otherTelephone>"
   if t8 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:otherfax>"&t8&"<"&"/c:otherfax>"
   if t9 <>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:pager>"&t9&"<"&"/c:pager>"
   if t10<>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:mobile>"&t10&"<"&"/c:mobile>"
   if t11<>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:othermobile>"&t11&"<"&"/c:othermobile>"
   if t12<>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:internationalisdnnumber>"&t12&"<"&"/c:internationalisdnnumber>"
   if t13<>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:telexnumber>"&t13&"<"&"/c:telexnumber>"
   if t14<>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:ttytddphone>"&t14&"<"&"/c:ttytddphone>"
   if t15<>"" then strPhoneInfo = strPhoneInfo & _
               "<"&"c:callbackphone>"&t15&"<"&"/c:callbackphone>"

   'Build WebDAV XML
   strXMLNSInfo = "xmlns:g=""DAV:"" " & _
        "xmlns:c=""urn:schemas:contacts:"" " & _
        "xmlns:e=""http://schemas.microsoft.com/exchange/"" " & _
        "xmlns:mapi=""http://schemas.microsoft.com/mapi/"" " & _
        "xmlns:x=""xml:"" xmlns:cal=""urn:schemas:calendar:"" " & _
        "xmlns:mail=""urn:schemas:httpmail:"">"

   ' Put all the information together in an HTTP request.
   strBody = "<" & "?" & "xml version=""1.0""?>" & _
        "<"&"g:propertyupdate " & strXMLNSInfo & _
            "<"&"g:set>" & _
                "<"&"g:prop>" & _
                    "<"&"g:contentclass>urn:content-classes:person" & _
                    "<"&"e:outlookmessageclass>IPM.Contact" & _
                    strPhoneInfo & _
                "<"&"/g:prop>" & _
            "<"&"/g:set>" & _
        "<"&"/g:propertyupdate>"
         
    ' Open the request object and assign the PROPPATCH method to it.
    Set objRequest = CreateObject("Microsoft.xmlhttp")
    objRequest.open "PROPPATCH", ContactURL, False, sUsername, sPassword
    ' Set the required headers for the request.
    objRequest.setRequestHeader "Content-Type", "text/xml"
    objRequest.setRequestHeader "Translate", "f"
    objRequest.setRequestHeader "Content-Length", Len(strBody)
    
    ' Send the request. Use the XML document as the body.
    objRequest.send strBody  
    
    'Display the results.
    If (objRequest.Status >= 200 And objRequest.Status < 300) Then
        Wscript.Echo "Updated: " & ContactURL
    End If
            
    Set objRequest = Nothing
  end if
End Sub

Sub SearchOU (oU, ServerURL, Username, Password) 
    ' Declare local variables
    Dim oUser, oSOU

    ' Find Computers
    oOU.Filter = Array("User")
    For Each oUser in oOU
        url = ServerURL & oUser.mail & "/Contacts/"
        SearchContacts url, Username, Password
    Next

    ' Search SubOU's if specified
    oOU.Filter = Array("OrganizationalUnit")
    For Each oSOU in oOU
        SearchOU oSOU, ServerURL, Username, Password
    Next
End Sub