Zugriff auf das globale Adressbuch von Outlook 97

[kiki]

Wie kann man mit Hilfe von OLE auf das globale Adressbuch von Outlook 97 zugreifen ?

(Ich will kein Virus schreiben !!!)

[BOrifice]

das war ein teil meines abschlußprojektes... allerdings mit outlook 98/2000 ob es mit 97 geht weiss ich nicht. folgender code ist VB und du musst ein verweis auf das ms outlook xx objektmodell machen:

kann dir gern den ganzen source mailen, sag bescheid.

Option Explicit

'-----------------------------------------------------------------------------

' searches the folder thePublicFolder for strValue from theCategory

'-----------------------------------------------------------------------------

Public Sub OutlookCompare(thePublicFolder As String, theCategory As String, theValue As String)

'local variables

Dim aApp As Object

Dim aNamespace As Object

Dim aPublicFolder As Object

Dim aContact As Object

Dim aItem As Object

Dim aNewFolder As Object

Dim alogFound As Boolean

alogFound = True

'create objects

Set aApp = CreateObject("Outlook.Application")

Set aNamespace = aApp.GetNamespace("MAPI")

Set aContact = aNamespace.Folders("Öffentliche Ordner")

Set aPublicFolder = aContact.Folders("Alle Öffentlichen Ordner")

'folder below "Alle Öffentlichen Ordner"

Set aNewFolder = aPublicFolder.Folders(thePublicFolder)

'search the folder strPublicFolder

Set aItem = aNewFolder.Items.Find("[" & theCategory & "] = '" & theValue & "'")

'if contact is not found then set alogFound to false

If (aItem Is Nothing) Then

alogFound = False

End If

'show the main app if minimized and a contact was not found

'else display the Outlook contact

If alogFound = False Then

If frmMain.WindowState = vbMinimized Then

frmMain.WindowState = vbNormal

End If

Else

'display the Outlook contact

aItem.Display

End If

'kill objects

Set aApp = Nothing

Set aNamespace = Nothing

Set aPublicFolder = Nothing

Set aContact = Nothing

Set aNewFolder = Nothing

Set aItem = Nothing

End Sub

'-----------------------------------------------------------------------------

' creates a new outlook contact in "thePublicFolder"

'-----------------------------------------------------------------------------

Public Sub createNewContact(thePublicFolder As String)

'local variables

Dim aApp As Object

Dim aNamespace As Object

Dim aPublicFolder As Object

Dim aContact As Object

Dim aItem As Object

Dim aNewFolder As Object

'create objects

Set aApp = CreateObject("Outlook.Application")

Set aNamespace = aApp.GetNamespace("MAPI")

Set aContact = aNamespace.Folders("Öffentliche Ordner")

Set aPublicFolder = aContact.Folders("Alle Öffentlichen Ordner")

'Folder below "Alle Öffentlichen Ordner"

Set aNewFolder = aPublicFolder.Folders(thePublicFolder)

Set aItem = aNewFolder.Items.Add

'display the Outlook contact

aItem.Display

'kill objects

Set aApp = Nothing

Set aNamespace = Nothing

Set aPublicFolder = Nothing

Set aContact = Nothing

Set aNewFolder = Nothing

Set aItem = Nothing

End Sub