Sub adr()
Dim objSession As MAPI.Session
Dim objRecipients As MAPI.Recipients
Dim objRecipient As MAPI.Recipient
Dim objMessage As MAPI.Message
Set objSession = New MAPI.Session
objSession.Logon
Set objRecipients = objSession.AddressBook( _
Recipients:=objRecipients, _
Title:="Wählen Sie den Empfänger", _
ForceResolution:=True, _
RecipLists:=3, _
ToLabel:="An", _
CcLabel:="Kopie", _
BccLabel:="Bcc")
If Not objRecipients Is Nothing Then
Set objMessage = objSession.Outbox.Messages.Add
End If
End Sub
Sub Test()
Dim MyOutApp As Object
Dim MyNS As Object
Dim ConFolder As Object
Dim ConRestrict As Object, ConItem As Object
Dim lngRow As Long
'Object Deklaration
Set MyOutApp = CreateObject("Outlook.Application")
'Zugriff auf die MAPI Schnittstelle
Set MyNS = MyOutApp.GetNamespace("MAPI")
Set ConFolder = MyNS.GetDefaultFolder(10)
'Filter setzen
Set ConRestrict = ConFolder.Items.Restrict("[FirstName] >= 'C' and [FirstName] <= 'F'")
With Sheets("Tabelle1") 'Tabelle anpassen
.Range("A2", .Cells(.Rows.Count, 3)).Clear 'leer machen für neue Daten
If ConRestrict.Count > 0 Then 'was gefunden
lngRow = 2
ConRestrict.Sort "[FirstName]" 'Sortieren
For Each ConItem In ConRestrict
With ConItem
Cells(lngRow, 1) = .Email1Address
Cells(lngRow, 2) = .LastName
Cells(lngRow, 3) = .FirstName
End With
lngRow = lngRow + 1
Next
.Columns("A:C").EntireColumn.AutoFit
End If
End With
End Sub