VBA OL 2000: Normale Kontakte und Verteilerlisten anzeigen

Hallo,

genauso wie bei Outlook auch, wenn man eine neue E-mail schreibt und auf Schaltfläche An klickt, so gibt bei mir eine Form, die mir alle Kontakte darstellt.

Man kann dort Kontaktordner in einer Combo auswählen. Unterhalb der Combo gibt es ein Listenfeld, welches die einzelnen Kontakte als E-mail darstellt.

Rechts daneben gibt es drei Listenfelder, wo die einzelnen Empfänger als An, Cc und Bcc gewählt werden können.

Bei Klick auf OK werden dann die einzelnen E-Mail-Adressen aus den drei Listenfeldern in das Haupfformular in die entsprechenden Textfelder An, Cc und Bcc gesetzt. Von dort aus soll dann die Nachricht an die einzelnen Empfänger versandt werden.

Die Auflösung der VL`s soll bewirken, dass ich nur E-Mail-Adressen habe, damit auch an die E-mail-Adressen die Mails gehen sollen. Wüsste nicht, wie ich das Textfeld behandeln müsste, damit der E-mail-Versand auch an eintrage VLs möglich wäre. Deshalb dieser Weg.

Meine Frage:
Wie kann man es erreichen, dass sowohl die normalen Kontakte auch auch die ausgelösten Verteilerlisten im Listenfeld angezeigt werden?

Was den fehlenden Code angeht, so sieht dieser wie folgt aus.

Private Sub UserForm_Activate()
On Error GoTo Fehlerbehandlung
Dim AppOL As Outlook.Application, NameSpaceOL As Outlook.NameSpace
Dim KontakteOL As Outlook.MAPIFolder, OrdnerOL As Outlook.MAPIFolder
Set AppOL = GetObject(, \“Outlook.Application\“)
Set NameSpaceOL = AppOL.GetNamespace(\“MAPI\“)
Set KontakteOL = NameSpaceOL.GetDefaultFolder(olFolderContacts)
Me.cmbKontakteOrdner.AddItem \“Hauptordner\“
For Each OrdnerOL In KontakteOL.Folders
Me.cmbKontakteOrdner.AddItem OrdnerOL.Name
Next
Me.cmbKontakteOrdner.ListIndex = 0
Exit Sub
Fehlerbehandlung:
If Err = 429 Then
Set AppOL = CreateObject(\“Outlook.Application\“)
End If
Resume Next
End Sub

Private Sub cmbKontakteOrdner_Change()
Dim AppOL As Outlook.Application, NameSpaceOL As Outlook.NameSpace
Dim OrdnerOL As Outlook.MAPIFolder, KontaktOL As Outlook.ContactItem
Dim MItem As Outlook.MailItem, VL As Outlook.DistListItem, rOL As Recipient, sTemp As String, co%, v%
Me.lstKontakte.Clear
If Me.cmbKontakteOrdner.ListIndex = 0 Then
Set OrdnerOL = NameSpaceOL.GetDefaultFolder(olFolderContacts)
Else
Set OrdnerOL = NameSpaceOL.GetDefaultFolder(olFolderContacts).Folders(Me.cmbKontakteOrdner.ListIndex)
End If
For i% = OrdnerOL.Items.Count To 1 Step -1
If TypeName(OrdnerOL.Items.Item(i)) = \“DistListItem\“ Then \’Verteilerliste gefunden?
Set VL = OrdnerOL.Items.Item(i) \’alte Verteilerliste dem Objekt zuweisen
Set TmpItem = AppOL.CreateItem(olMailItem) \’DummyMailItem erzeugen um ein leeres Recipients-Objekt zu erhalten
Set Rc = TmpItem.Recipients \’das leere Recipients-Objekt zuweisen
For j% = 1 To VL.MemberCount \’alle Mitglieder der Verteilerliste absuchen
strTmp = Trim(LSLeftBack(VL.GetMember(j%).Address, \“(E-Mail)\“)) \’verfälschten OL-Anzeigenamen korrigieren
\‘ VLName = VL.DLName
If strTmp <> \“\“ Then \’Name in Verteilerliste nicht leer?
Rc.Add strTmp \’zu Recipients hinzufügen
If Rc.ResolveAll = True Then \’kann aufgelöst werden?
If Rc(1).Address <> \“\“ Then \’EMail-Adresse vorhanden?
For Each meinRC In Rc
Me.lstKontakte.AddItem meinRC.Address
Next
End If
End If
End If
Next
End If
Next
End Sub

Function LSLeftBack(st_parm_fullString As String, st_parm_startString As String)
Dim st_fullString As String
Dim st_startString As String
Dim st_storestring As String
st_fullString = st_parm_fullString
st_startString = st_parm_startString
Dim i_position As Integer
Dim i_tmp As Integer
st_storestring = st_fullString

i_position = InStr(st_fullString, st_startString)

If i_position <> 0 Then
i_tmp = i_position
Do While i_position > 0
st_fullString = Mid(st_fullString, i_position + 1)
i_position = InStr(st_fullString, st_startString)
i_tmp = i_tmp + i_position
Loop
LSLeftBack = Left$(st_storestring, i_tmp – 1)
Else
LSLeftBack = st_fullString
End If
End Function

mfg
BenC