Results 1 to 5 of 5
  1. #1
    5 Star Lounger
    Join Date
    Jul 2001
    Location
    Terneuzen, Netherlands
    Posts
    895
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I'd like to be able to input a user's name and get the data as stored in our Exchange server (e.g. telephonenr, department, location). This is the code I have and it does resolve the ID I enter to the user name (using late binding):

    Dim OLF As Object, olMailItem As Object, ToContact As Object
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDef aultFolder(6) 'olFolderInbox
    Set olMailItem = OLF.Items.Add ' creates a new e-mail message
    '
    Set ToContact = olMailItem.Recipients.Add("USerID")
    ToContact.Resolve
    If ToContact.Resolved Then UserName= olMailItem.Recipients(1).Name
    '
    Set ToContact = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing

    Now how do I get the rest of the info? Is that possible?

    I also have other code that uses CDO and does work with lines like: objmember.Fields(CdoPR_INITIALS).Value
    Problem is that this code is quite entangled into something else and it would be quite complex to lift the relevant few lines out and convert them so they function.

    Any suggestions, tips or pieces of code I can use?

  2. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    [quote name='ErikJan' post='793533' date='16-Sep-2009 06:57']I'd like to be able to input a user's name and get the data as stored in our Exchange server (e.g. telephonenr, department, location).[/quote]
    I think we had a thread like that in the past... could it have been using the LDAP interface to retrieve data from AD? Maybe these old threads from 2004 help:

    [topic="400344"]Reading from Active Directory in a form (Word VBA) (VB / VBA)[/topic]
    [topic="405925"]Pulling a list of all users from Active Directory (Word 2003 VBA) (VB / VBA)[/topic]

  3. #3
    5 Star Lounger
    Join Date
    Jul 2001
    Location
    Terneuzen, Netherlands
    Posts
    895
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='jscher2000' post='793608' date='16-Sep-2009 23:27']I think we had a thread like that in the past... could it have been using the LDAP interface to retrieve data from AD? Maybe these old threads from 2004 help:

    [topic="400344"]Reading from Active Directory in a form (Word VBA) (VB / VBA)[/topic]
    [topic="405925"]Pulling a list of all users from Active Directory (Word 2003 VBA) (VB / VBA)[/topic][/quote]

    OOPS, that's more complex than I thought. Guess I'll give another go at my existing CDO-based approach... Any solutions in that corner out there maybe?

  4. #4
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    [quote name='ErikJan' post='793620' date='16-Sep-2009 15:16']Guess I'll give another go at my existing CDO-based approach... Any solutions in that corner out there maybe?[/quote]
    No personal experience. The Recipient Object looks a bit limited...

  5. #5
    5 Star Lounger
    Join Date
    Jul 2001
    Location
    Terneuzen, Netherlands
    Posts
    895
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='jscher2000' post='793629' date='17-Sep-2009 00:52']No personal experience. The Recipient Object looks a bit limited...[/quote]

    I spent some time on my CDO code and got it to work; here's the relevant piece of the code, maybe not super optimized, but it works!:

    Sub U_2_N()
    Dim objSession As MAPI.Session
    Dim objNewMessage As MAPI.Message
    Dim objNewRecip
    Dim i As Integer, Recip As String
    '
    On Error GoTo NoMAPI
    Set objSession = CreateObject("MAPI.Session")
    objSession.Logon ShowDialog:=False, NewSession:=False
    '
    Range("B5:M2000").Clear
    i = 4
    '
    Recip = Range("A1").Offset(i, 0)
    Do While Recip <> ""
    Set objNewMessage = objSession.Outbox.Messages.Add ' Create new message
    Set objNewRecip = objNewMessage.Recipients.Add
    objNewRecip.Name = Recip
    objNewRecip.Resolve ' Resolve address against the Exchange Directory
    '
    On Error Resume Next
    With objNewRecip.AddressEntry
    Range("B1").Offset(i, 0) = .Fields(CdoPR_ACCOUNT).Value 'UID
    Range("B1").Offset(i, 1) = .Fields(CdoPR_GIVEN_NAME).Value 'First Name
    Range("B1").Offset(i, 2) = .Fields(CdoPR_SURNAME).Value 'Lastname
    Range("B1").Offset(i, 3) = .Fields(CdoPR_INITIALS).Value ' Initials
    Range("B1").Offset(i, 4) = .Fields(CdoPR_DISPLAY_NAME).Value ' Display Name
    Range("B1").Offset(i, 5) = .Fields(CdoPR_LOCALITY).Value 'Location
    Range("B1").Offset(i, 6) = .Fields(CdoPR_COMPANY_NAME).Value 'Company
    Range("B1").Offset(i, 7) = .Fields(CdoPR_DEPARTMENT_NAME).Value 'Department Name
    Range("B1").Offset(i, 8) = .Fields(CdoPR_OFFICE_LOCATION).Value 'Building/Office
    Range("B1").Offset(i, 9) = .Fields(CdoPR_COUNTRY).Value 'Country
    Range("B1").Offset(i, 10) = .Fields(CdoPR_BUSINESS_TELEPHONE_NUMBER).Value 'Business Phone
    Range("B1").Offset(i, 11) = .Fields(CdoPR_MOBILE_TELEPHONE_NUMBER).Value 'Mobile Phone
    End With
    objNewMessage.Delete ' Delete message
    i = i + 1
    Recip = Range("A1").Offset(i, 0)
    Loop
    objSession.Logoff
    '
    On Error GoTo 0
    '
    Ext:
    Application.StatusBar = False
    Set objNewRecip = Nothing
    Set objNewMessage = Nothing
    Set objSession = Nothing
    Exit Sub
    '
    NoMAPI:
    MsgBox "Cannot initiate Mail-system", vbCritical + vbOKCancel, "U_2_N"
    GoTo Ext
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •