smtp Exchange Server - Nur Angezeigter Name

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Guten morgen,Danke für deine Hilfe....
Leider kann ich nicht den ganzen code posten.Aber ich hoffe das reicht.
So lese ich oder Starte ich das Addressbuch, wähle einen Empfänger aus.
Und von diesem Empfänger benötige ich die smtp Addresse und nicht den angezeigten Namen.
Danke nochnochmals für die Hilfe !!
gruß Chris
Dim objSession As MAPI.Session
Dim objRecipients As MAPI.Recipients
Dim objRecipient As MAPI.Recipient
Dim iRow As Integer
Set objSession = CreateObject("MAPI.Session")
''objSession.Logon "Default Outlook Profile"
objSession.Logon "", , , False
On Error Resume Next
Set objRecipients = objSession.AddressBook( _
Recipients:=objRecipients, _
Title:="Wählen Sie den oder die Empfänger - Verteiler 1")
If Not objRecipients Is Nothing Then
Worksheets("Verteiler").Unprotect "p"
For Each objRecipient In objRecipients
For iRow = 2 To 100
If iRow = 100 Then End
If Worksheets("Verteiler").Cells(iRow, x) = "" Then
Exit For
Else
End If
Next
Cells(iRow, x).Value = objRecipient.Name
Next objRecipient
Worksheets("Verteiler").Protect "p"
End If
objSession.Logoff
Exit Sub

Sub neu() Dim objSession As MAPI.Session Dim objRecipients As MAPI.Recipients Dim objRecipient As MAPI.Recipient Dim iRow As Integer Dim x As Integer Set objSession = CreateObject("MAPI.Session") ''objSession.Logon "Default Outlook Profile" objSession.Logon "", , , False On Error Resume Next Set objRecipients = objSession.AddressBook( _ Recipients:=objRecipients, _ Title:="Wählen Sie den oder die Empfänger - Verteiler 1") If Not objRecipients Is Nothing Then objRecipients.ResolveAll objRecipient.Resolve For Each objRecipient In objRecipients objRecipients.ResolveAll objRecipient.Resolve Next objRecipient End If objSession.Logoff Exit Sub End Sub

Sub neu() Dim objSession As MAPI.Session Dim objRecipients As MAPI.Recipients Dim objRecipient As MAPI.Recipient Dim iRow As Integer Dim x As Integer Dim xx Set objSession = CreateObject("MAPI.Session") ''objSession.Logon "Default Outlook Profile" objSession.Logon "", , , False On Error Resume Next Set objRecipients = objSession.AddressBook( _ Recipients:=objRecipients, _ Title:="Wählen Sie den oder die Empfänger - Verteiler 1") For Each objRecipient In objRecipients MsgBox objRecipient.Name objRecipient.Resolveall MsgBox objRecipient.Name Next objRecipient objSession.Logoff Exit Sub End Sub

ich setzte mal auf geschlossen.
Habe eine möglichkeit gefunden.Ist zwar nicht sehr sauber aber klappt einigermaßen..
die schleife habe ich eingebaut weil ich die smtp Addresse manchmal unter item z.b 30 finde und manchmal unter 31 oder 32 danke noch einmal ! An alle !!!
Dim objSession As MAPI.Session
Dim objRecipients As MAPI.Recipients
Dim objRecipient As MAPI.Recipient
Dim iRow As Integer
Set objSession = CreateObject("MAPI.Session")
''objSession.Logon "Default Outlook Profile"
objSession.Logon "", , , False
On Error Resume Next
Set objRecipients = objSession.AddressBook( _
Recipients:=objRecipients, _
Title:="Wählen Sie den oder die Empfänger - Verteiler 1")
If Not objRecipients Is Nothing Then
Worksheets("Verteiler").Unprotect "p"
For Each objRecipient In objRecipients
For iRow = 2 To 100
'Leere zeile finden
If iRow = 100 Then End
If Worksheets("Verteiler").Cells(iRow, x) = "" Then
Exit For
Else
End If
Next
anz = UCase(objRecipient.AddressEntry.Fields.Count)
On Error GoTo fehler
For xx = 40 To anz
If InStr(objRecipient.AddressEntry.Fields(xx).Value, "@") > 0 Then
Exit For
Else
End If
Next
Cells(iRow, x).Value = objRecipient.AddressEntry.Fields(xx).Value
Next objRecipient
Worksheets("Verteiler").Protect "p"
End If
objSession.Logoff
Exit Sub
verteiler:
For iRow = 2 To 100
If iRow = 100 Then End
If Worksheets("Verteiler").Cells(iRow, x) = "" Then
Exit For
Else
End If
Next
Worksheets("Verteiler").Unprotect "passi"
Cells(iRow, x).Value = wer_smtp
Worksheets("Verteiler").Protect "passi"
Exit Sub
fehler:
MsgBox ("fehler beim hinzufügen einer Addresse"), vbCritical, "Bitte an Administratior wenden"
End Sub

Option Explicit '*********************************************************** '*Benötigt den Verweis auf Microsoft Outlook Object Library* '*********************************************************** Sub LeseSenderMailAddress() Dim objOutlook As Outlook.Application Dim objNameSpace As Namespace Dim objFolder As MAPIFolder Dim objMsg As MailItem Dim lngRow As Long Set objOutlook = New Outlook.Application Set objNameSpace = objOutlook.GetNamespace("MAPI") Set objFolder = objNameSpace.Folders("Persönliche Ordner").Folders("Posteingang") Application.ScreenUpdating = False On Error Resume Next For Each objMsg In objFolder.Items lngRow = lngRow + 1 Cells(lngRow, 1) = objMsg.SenderEmailAddress Next objMsg On Error GoTo 0 Application.ScreenUpdating = True Set objMsg = Nothing Set objFolder = Nothing Set objNameSpace = Nothing Set objOutlook = Nothing End Sub

Option Explicit '*********************************************************** '*Benötigt den Verweis auf Microsoft Outlook Object Library* '*********************************************************** Sub test() Dim objOutlook As Outlook.Application Dim objNameSpace As Namespace Dim objMapiFolder As MAPIFolder Dim objItems As Items Dim zaehler As Integer Set objOutlook = New Outlook.Application Set objNameSpace = objOutlook.GetNamespace("MAPI") Set objMapiFolder = objNameSpace.GetDefaultFolder(olFolderContacts) Set objItems = objMapiFolder.Items Application.ScreenUpdating = False For zaehler = 1 To objItems.Count Cells(zaehler, 1) = objItems(zaehler).Email1Address Next zaehler Application.ScreenUpdating = True Set objNameSpace = Nothing Set objNameSpace = Nothing Set objMapiFolder = Nothing Set objItems = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

smtp Exchange Server - Nur Angezeigter Name

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

smtp Exchange Server - Nur Angezeigter Name

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread