HELP! E-mail list

[vbuser1976]

My new question is this: Is there a way I can populate a list box with the Outlook recipients list on our exchange server? And can the list be set up in away that the box refreshes itself?(you know, just in case the admin adds a new email address to the list)

[Lafor]

I have been looking for this thread since the previous one was closed... So I had to attempt e-mailing personally but here we go....

This very disorganized but it will work and any questions
let me know...

I put everything in the Form_Load
Create 2 list boxes (List1 and List2) on the form
Goto Project References and hook the Collaboration Data Objects

and this should run like a charm


Here we go

Private Sub Form_Load()
Dim objRecipientList, objUserList, objUser, objUserSess, objSession
Dim strUserID, strUserName, strUserMail, strUserHomeServer, strProfileInfo
Dim i As Integer
Dim g_Const_MBX
Dim g_Const_ReportFile
Dim CdoPR_ACCOUNT
Dim CdoPR_MAILBOX_SIZE
Dim CdoPR_EMAIL
Dim CdoPR_CONTENT_COUNT
Dim CdoPR_CONTENT_UNREAD
Dim PR_EMS_AB_HOME_MTA
Dim PR_LAST_LOGON_TIME
Dim PR_LAST_LOGOFF_TIME

CdoPR_EMAIL = &H39FE001E ' SMTP address of the mailbox

' MAPI properties which are documented
CdoPR_ACCOUNT = &H3A00001E ' Alias
CdoPR_CONTENT_COUNT = &H36020003 ' Count of all messages of the mailbox
CdoPR_CONTENT_UNREAD = &H36030003 ' Count of unread messages of the inbox
PR_EMS_AB_HOME_MTA = &H8007001E ' Home MTA needed to get the home server name


' Initialize error handling
On Error Resume Next

' Set mouse pointer
Screen.MousePointer = vbHourglass

' Initialize objects
Set objSession = Nothing
Set objInfoStore = Nothing
Set objInbox = Nothing
Set objFolder = Nothing
Set objAddressLists = Nothing
Set objAddressList = Nothing
Set objContactEntry = Nothing
Set objAddressEntries = Nothing
Set objAddressEntry = Nothing
Set objRecipients = Nothing
Set objRecipient = Nothing
Set objMessages = Nothing
Set objMessage = Nothing
Set objFields = Nothing
Set objField = Nothing


' MAPI session logon
Set objSession = New MAPI.Session
Err.Clear
objSession.Logon NewSession:=False, showDialog:=True

' Set mouse pointer
Screen.MousePointer = vbHourglass
DoEvents

' MAPI logon successfully?
If Err.Number = 0 Then

' Set return code for MAPI logon
strRetCode = "OK"

' Check CDO Version
If Left(objSession.Version, 3) <> "1.2" Then

' Reset mouse pointer
Screen.MousePointer = vbNormal

' Too bad, that's to old, show error message and exit
MsgBox "You must have CDO 1.2 installed to use this program. CDO 1.2 comes with Outlook 98 (or higher).", vbOKOnly + vbInformation, App.ProductName

' Exit application
Unload Me
Else

' Get inbox folder
Set objInbox = objSession.Inbox

' Get infostore
Set objInfoStore = objSession.GetInfoStore(objInbox.StoreID)

' Reset mouse pointer
Screen.MousePointer = vbNormal

' Display address book dialog
Err.Clear
'Set objRecipientList = Nothing
Set objRecipientList = objSession.GetAddressList(0)

' No errors detected ?
If Err.Number = 0 Then
Set objUserList = objRecipientList.AddressEntries
Else
' Could not get global address list, write logging
MsgBox "Error - Could not get global address list"
End If

' Check if userlist is not empty
If Not objUserList Is Nothing Then

' Loop through the userlist
For Each objUser In objUserList

' Check if the object is a mailbox
If objUser.DisplayType = 0 Then

strUserHomeServer = objUser.Fields(PR_EMS_AB_HOME_MTA)
strUserHomeServer = Mid(strUserHomeServer, _
InStr(1, strUserHomeServer, _
"/cn=Configuration/cn=Servers/cn=") _
+ Len("/cn=Configuration/cn=Servers/cn="), 255)
strUserHomeServer = Left(strUserHomeServer, _
InStr(1, strUserHomeServer, "/") - 1)

'---------- Here we get the e-mail
Set objUserSess = Nothing
On Error Resume Next
Set objUserSess = CreateObject("MAPI.Session")

If Not objUserSess Is Nothing Then

' Logging on with user, write logging
'MsgBox "Logging on with user: " & objUser.Name
List2.AddItem objUser.Name
' Create MAPI profile and logon to the user mailbox
Err.Clear
strProfileInfo = strUserHomeServer & Chr(10) & objUser.Fields.Item(CdoPR_ACCOUNT).Value
On Error Resume Next
objUserSess.Logon "", "", False, True, 0, False, strProfileInfo
' No errors detected ?
If Err.Number = 0 Then

strUserID = objUserSess.CurrentUser.ID
strUserName = objUserSess.CurrentUser
strUserMail = objUserSess.GetAddressEntry(strUserID).Fields(CdoPR_EMAIL)
List1.AddItem strUserMail
End If
End If
End If
Next
End If
End If
End If
End Sub




Good luck!

[vbuser1976]

It does not seem to be working. The code you gave seems to have a recursive loop somewhere. Any more suggestions out there? Thanks for all your help.

[HeSaidJoe]

Option Explicit

Private Sub Form_Load()
'set a reference to outlook in references

Dim moMail As Object
Dim loNameSpace As Object
Dim loNameAddresses As Object
Dim loAddresses As Object
Dim loAddressList As Object

Set moMail = New Outlook.Application
Dim moAddresses As Outlook.AddressLists

Set loNameSpace = moMail.GetNamespace("MAPI")
Set loAddresses = loNameSpace.AddressLists("Contacts")

Set loAddressList = loAddresses.AddressEntries
List1.Clear

 Dim intcre As Integer
For intcre = 1 To loAddressList.Count
    List1.AddItem loAddressList.Item(intcre).Name
    List1.AddItem loAddressList.Item(intcre).Address
    List1.AddItem "________________________________"
    List1.AddItem ""
Next intcre
End Sub

[Edited by HeSaidJoe on 10-23-2000 at 09:43 AM]