Function GetDN(UserName)
  Const ADS_NAME_INITTYPE_GC = 3
  Const ADS_NAME_TYPE_1779   = 1
  Const ADS_NAME_TYPE_NT4    = 3

  Dim NameTranslate, Result

  Set NameTranslate = CreateObject("NameTranslate")
  NameTranslate.Init ADS_NAME_INITTYPE_GC, ""

  ' If a domain name is not specified, use the current domain.
  If InStr(UserName, "\") = 0 Then
    UserName = CreateObject("WScript.Network").UserDomain _
      & "\" & UserName
  End If

  On Error Resume Next
  NameTranslate.Set ADS_NAME_TYPE_NT4, UserName
  If Err.Number = 0 Then
    Result = NameTranslate.Get(ADS_NAME_TYPE_1779)
  Else
    Result = ""
  End If

  GetDN = Result
End Function
strUser=Inputbox("Username to get the DN from:")

Set objUser = GetObject("LDAP://" & GetDN(strUser))
If objUser.HomeMDB="" then Wscript.echo "User has no mailbox.":Wscript.quit 1
strExchange = mid(objUser.HomeMTA,instr(objUser.Homemta,",")+1)
if instr(strExchange,",")-1>0 then
  strExchange = left(strExchange,instr(strExchange,",")-1)
End iF
strExchange = mid(strExchange,4)
DN=inputbox("User located on " & strExchange & " with Exchange UserDN","UserDN",objUser.get("legacyExchangeDN"))