ahstax
Oct 11, 2017
view1925
view6
0
Goto Top

OL, VBA, Name des Publ Folders herausbekommen

GermansolvedQuestionBasicDevelopment
Hallo,

ich schreibe ein Makro, mit dem man in OL (hier 2013) eine E-Mail aus einem Spam-Filter-Ordner in den Posteingang des ursprünglichen Adressaten zu verschieben.
Für eine Person mit Postfach funktioniert das. Auch wenn der ursprüngliche Adressat die "Haupt-E-Mail-Adresse" (Adresse 1) eines öffentlichen Ordners ist funktioniert mein Code.
Allerdings habe ich ein Problem, wenn der Öffentliche Ordner weitere E-Mail-Adressen hat (Adresse 2, ..., Adresse n). Ohne es getestet zu haben nehme ich an, dass ich ein ähnliches Problem bekommen könnte, wenn eine Person mit Postfach mehrere E-Mail-Adressen hat.

Ich suche nun einen Weg, mit dem ich, basierend auf der vorliegenden E-Mail-Adresse (Adresse 2) die Hauptadresse (Adresse 1) herausfinden kann. Wie kann ich das anstellen?

Wenn weitere Infos nötig sind, stelle ich die gerne zur Verfügung.

Neugierige Grüße,
Andreas
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 351409

Url: https://administrator.de/contentid/351409

Printed on: April 24, 2024 at 15:04 o'clock

6 Comments
Latest comment
Goto Top
Member: emeriks
Solution emeriks Oct 11, 2017 updated at 12:01:08 (UTC)
Goto Top
Hi,
AD via LDAP abfragen mit Filter "(proxyAddresses=SMTP:email@adresse.de)"
Beim betreffenden Objekt das ganze Attribut "proxyAddresses" auslesen. Das ist ein Array.
Die erste Adresse im Array mit "SMTP:" in Großbuchstaben am Anfang ist die primäre SMTP-Adresse dieses Empfängers.

E.
heart1
Member: colinardo
Solution colinardo Oct 11, 2017 updated at 12:28:14 (UTC)
Goto Top
Servus Andreas,
die PrimarySmtpAddress bekommst du in Outlook so
Sub ShowPrimarySMTPAddressForRecipient()
    Dim rec As Recipient, usr as ExchangeUser
    Set rec = Application.GetNamespace("MAPI").CreateRecipient("Max Mustermann")  
    rec.Resolve
    If rec.Resolved Then
        set usr = rec.AddressEntry.GetExchangeUser()
        if not usr is Nothing then
            msgbox usr.PrimarySmtpAddress
        End if
    Else
        MsgBox "Kontakt konnte nicht gefunden werden", vbExclamation  
    End If
End Sub
oder eben direkt
Set objUser = GetObject("LDAP://cn=Max Muster,cn=Users,dc=mydomain,dc=mytld")  
msgbox "E-MailAddress: " & objUser.EMailAddress
oder Ausführlich über LDAP (s. Emeriks)
set objUser = FindAccount("user@domain.tld")  
if not objUser is nothing then
	msgbox objUser.EMailAddress
else
	msgbox "User nicht gefunden.",vbExclamation  
End if

Function FindAccount(strMail)
	On Error Resume Next
	Dim adoCommand, adoConnection
	Dim varBaseDN, varFilter
	Dim objRootDSE, varDNSDomain, strQuery, adoRecordset

	Set adoCommand = CreateObject("ADODB.Command")  
	Set adoConnection = CreateObject("ADODB.Connection")  
	adoConnection.Provider = "ADsDSOObject"  
	adoConnection.Open "Active Directory Provider"  
	Set adoCommand.ActiveConnection = adoConnection
	
	' Search entire Active Directory domain.  
	Set objRootDSE = GetObject("LDAP://RootDSE")  
	
	varDNSDomain = objRootDSE.Get("defaultNamingContext")  
	varBaseDN = "<LDAP://" & varDNSDomain & ">"  
	
	' Filter for user objects.  
	varFilter = "(&(objectClass=user)(proxyAddresses=smtp:" & strMail & "))"  
	
	' Construct the LDAP syntax query.  
	adoCommand.CommandText = varBaseDN & ";" & varFilter & ";ADSPath;Subtree"  
	adoCommand.Properties("Page Size") = 2  
	adoCommand.Properties("Timeout") = 20  
	adoCommand.Properties("Cache Results") = False  
	Set adoRecordset = adoCommand.Execute
	adoRecordset.MoveFirst

	If adoRecordset.RecordCount > 0 Then
		set FindAccount = GetObject(adoRecordset("ADSPath"))  
	else
		set FindAccount = Nothing
	End If
	
	adoRecordset.Close
	adoConnection.Close
End Function
Grüße Uwe
heart1
Member: ahstax
ahstax Oct 11, 2017 at 12:40:26 (UTC)
Goto Top
Cool! Danke! Damit bekomme ich auf jeden Fall die User abgefangen!
Was damit leider nicht geht, ist das Auslesen der Namen öffentlicher Ordner basierend auf einer vorliegenden E-Mail-Adresse...
Member: emeriks
Solution emeriks Oct 11, 2017 at 12:50:37 (UTC)
Goto Top
Dann nimm als Filter einfach
varFilter = "(proxyAddresses=smtp:" & strMail & ")"
heart1
Member: colinardo
Solution colinardo Oct 11, 2017 updated at 13:29:06 (UTC)
Goto Top
Zitat von @ahstax:

Cool! Danke! Damit bekomme ich auf jeden Fall die User abgefangen!
Was damit leider nicht geht, ist das Auslesen der Namen öffentlicher Ordner basierend auf einer vorliegenden E-Mail-Adresse...
Doch das kannst du auch via LDAP abfragen wenn du die Mail des öffentlichen Ordners hast, denn die Infos liegen ebenfalls im AD im Container CN=Microsoft Exchange System Objects.
Also die Method minimal angepasst das der BaseDN auf den System-Container zeigt und der Filter nur Public Folder mit der passenden Adresse filtert
set objFolder = FindAccount("publicfolder@domain.tld")  
if not objFolder is nothing then
	msgbox "Ordnername des mailaktivierten öffentlichen Ordners: " & objFolder.DisplayName  
else
	msgbox "Öffentlicher Ordner nicht gefunden.",vbExclamation  
End if


Function FindAccount(strMail)
	On Error Resume Next
	Dim adoCommand, adoConnection
	Dim varBaseDN, varFilter
	Dim objRootDSE, varDNSDomain, strQuery, adoRecordset

	Set adoCommand = CreateObject("ADODB.Command")  
	Set adoConnection = CreateObject("ADODB.Connection")  
	adoConnection.Provider = "ADsDSOObject"  
	adoConnection.Open "Active Directory Provider"  
	Set adoCommand.ActiveConnection = adoConnection
	
	' Search entire Active Directory domain.  
	Set objRootDSE = GetObject("LDAP://RootDSE")  
	
	varDNSDomain = objRootDSE.Get("defaultNamingContext")  
	varBaseDN = "<LDAP://CN=Microsoft Exchange System Objects," & varDNSDomain & ">"  
	
	' Filter for user objects.  
	varFilter = "(&(objectClass=publicFolder)(proxyAddresses=smtp:" & strMail & "))"  
	
	' Construct the LDAP syntax query.  
	adoCommand.CommandText = varBaseDN & ";" & varFilter & ";ADSPath;OneLevel"  
	adoCommand.Properties("Page Size") = 2  
	adoCommand.Properties("Timeout") = 20  
	adoCommand.Properties("Cache Results") = False  
	Set adoRecordset = adoCommand.Execute
	adoRecordset.MoveFirst

	If adoRecordset.RecordCount > 0 Then
		set FindAccount = GetObject(adoRecordset("ADSPath"))  
	else
		set FindAccount = Nothing
	End If
	
	adoRecordset.Close
	adoConnection.Close
End Function
heart1
Member: ahstax
ahstax Oct 11, 2017 at 13:51:23 (UTC)
Goto Top
GRANDIOS!

Herzlichen Dank!
GermansolvedQuestionBasicDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments