email adresser på exchange server

Hvordan kan jeg lave et udtræk af alle email adresser på min exchange server, jeg har et lille scrpt:

Dim rootDSE, domainObject
Set rootDSE=GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & domainContainer)

Set fs = CreateObject ("Scripting.FileSystemObject")
Set userFile = fs.CreateTextFile ("c:\users.csv")

ExportUsers(domainObject)

Set oDomain = Nothing
MsgBox "Finished"
WScript.Quit

Sub ExportUsers(oObject)
    Dim oUser
    For Each oUser in oObject
        Select Case oUser.Class
        Case "contact"
            If oUser.mail <> "" then
                userFile.Write "," & oUser.displayName & "," & oUser.sAMAccountName & "," & oUser.userprincipalname & "," & oUser.msExchHomeServerName & ","
                for each email in oUser.proxyAddresses
                    userFile.Write email & ","
                next
                userFile.WriteLine ""
            End if
        Case "organizationalUnit" , "container"
            If UsersinOU (oUser) then
                ExportUsers(oUser)
            End if
        End select
    Next
End Sub

Function UsersinOU (oObject)
    Dim oUser
    UsersinOU = False
    for Each oUser in oObject
        Select Case oUser.Class
            Case "organizationalUnit" , "container"
                UsersinOU = UsersinOU(oUser)
            Case "user"
                UsersinOU = True

        End select
    Next
End Function


problemet er at der kommer kun email adresser på de brugerne ikke på dem som bare er oprettet som contacts..

hvad skal der til for at det te kan lade sig gøre ??