Sep 05, 2006, updated at Sep 14, 2006 (UTC)
10118
2
0
- Copy internal post link
- Copy external post link
- Report article
https://administrator.de/forum/exchange-oeffentliche-ordner-per-vbscript-o-ae-email-aktivieren-39410.html
[content:39410]
Exchange Öffentliche Ordner per VBScript o.ä. Email-aktivieren
Wer weiss, ob und wie man ÖO in Exchange per VBScript Email-aktivieren bzw. deaktivieren kann.
Ich suche eine Möglichkeit, die Öffentliche-Ordner-Struktur in VB (bzw. VBA) auszulesen (funktioniert auch soweit) und zu prüfen, welche Ordner Email-aktiviert sind, und welche nicht (das habe ich leider nicht gefunden). Die Eigenschaft möchte ich dann gegebenenfalls ändern.
Gruß Jehemo2001
Gruß Jehemo2001
Please also mark the comments that contributed to the solution of the article
Content-Key: 39410
Url: https://administrator.de/contentid/39410
Printed on: April 26, 2024 at 18:04 o'clock
2 Comments
Latest comment
- Comment overview - Please log in
astera Sep 14, 2006 at 07:32:57 (UTC)
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/exchange-oeffentliche-ordner-per-vbscript-o-ae-email-aktivieren-39410.html#comment-162336
[content:39410#162336]
Hallo,
1.
was meinst Du mit "Email aktivieren"?
2.
Wie liest Du ÖO aus?
LG
astera
1.
was meinst Du mit "Email aktivieren"?
2.
Wie liest Du ÖO aus?
LG
astera
Jehemo2001 Sep 14, 2006 at 09:09:05 (UTC)
- Copy internal comment link
- Copy external comment link
- To the beginning of the comments
https://administrator.de/forum/exchange-oeffentliche-ordner-per-vbscript-o-ae-email-aktivieren-39410.html#comment-162381
[content:39410#162381]
Zu 1: Im Emails direkt an öffentliche Ordner zuzustellen, müssen diese Email-aktiviert werden. Das kann man über den System-Manager machen.
In ordner, öffentliche Ordner rechte Maustatste auf den Ordner, alle Tasks und dann Email aktivieren.
zu 2:
ich lese das AD wie folgt aus:
Function ReadAD()
On Error Resume Next
Const AccessTable = "ADEmailadressen"
' List of Folders who should NOT be exported
' This list should contain the Folder's logon name
' Separate each name by a comma
Const Folders2Skip = ""
' Constant for the search to search subtrees
Const ADS_SCOPE_SUBTREE = 2
Const adOpenStatic = 3
Const adLockOptimistic = 3
' General variable declarations
Dim objConnectionDB As Database
Dim objRecordsetDB As Recordset
Dim objConnectionAD, objCommandAD, objRecordsetAD
Dim strSQL
Dim objRootDSE, strDNSDomain
Dim strDN, strDisplayName
Dim objFolder
Dim i
'Create and open ADO connection to the Access database
Set objConnectionDB = CurrentDb
Set objRecordsetDB = objConnectionDB.OpenRecordset("ADEmailAdressen", dbOpenTable)
' Define the SQL statement used to clear out previous
' Folder info which was exported from AD
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM ADEmailAdressen WHERE ImportedFromAD = True"
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP:RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Create and open an ADO connection to AD
Set objConnectionAD = CreateObject("ADODB.Connection")
Set objCommandAD = CreateObject("ADODB.Command")
objConnectionAD.Provider = "ADsDSOObject"
objConnectionAD.Open "Active Directory Provider"
' Set connection properties
With objCommandAD
.ActiveConnection = objConnectionAD
' Use SQL syntax for the query
' This retrieves all values named in the SELECT section for
' Folder accounts which do not have the Notes section = NoExport.
' The recordset is sorted ascending on the displayName value.
.CommandText = "Select distinguishedName, name, ObjectClass," & _
" displayName, msExchHideFromAddressLists, givenname, sn, cn, mail, " & _
" sAMAccountname, displayName, textEncodedORAddress" & _
" FROM 'LDAP:" & strDNSDomain & "'" & _
" WHERE objectCategory = 'person' AND objectClass='user' OR" & _
" objectCategory='publicFolder' or objectCategory='group' OR" & _
" objectCategory='contact' OR objectCategory='msExchDynamicDistributionList'" & _
" ORDER BY displayName"
' "distinguishedName,name,ObjectClass,LegacyExchangeDN,msExchADCGlobalNames," & _
' "displayName,msExchHideFromAddressLists,hideDLMembership,msexchmasteraccountsid," & _
' "msExchALObjectVersion,showInAddressBook,msExchPolicyEnabled,givenName,sn,cn,mailNickname,targetAddress,proxyAddresses," & _
' "mail,textEncodedORAddress,msExchHomeServerName,msExchExpansionServerName,msExchCustomProxyAddresses,msExchPoliciesIncluded," & _
' "msExchPoliciesExcluded,homeMDB,homeMTA,msExchMailboxGuid,unmergedAtts,msExchDynamicDLFilter,msExchPurportedSearchUI," & _
' "msExchMailboxSecurityDescriptor,msExchResourceGUID,UserAccountControl,msExchUserAccountControl
.Properties("Page Size") = 1000
.Properties("Timeout") = 30
.Properties("Searchscope") = ADS_SCOPE_SUBTREE
.Properties("Cache Results") = False
End With
Set objRecordsetAD = objCommandAD.Execute
' Move to the first record in the recordset
objRecordsetAD.MoveFirst
' Loop until we reach the end of the recordset
Do While Not objRecordsetAD.EOF
' Get the distinguished name of this folder
' The syntax is something like:
' CN=Joe E. Law,OU=Sales,OU=US,DC=mydomain,DC=local
strDN = objRecordsetAD.Fields("distinguishedName")
' Bind to the user object
Err.Clear
Set objFolder = GetObject("LDAP://" & strDN & "")
With objFolder
If Err.Number = 0 And _
Not IsNull(.DisplayName) And Trim(.DisplayName) <> "" And Not IsNull(.mail) And Trim(.mail) <> "" _
And InStr(.DisplayName, "SystemMailbox") = 0 _
And InStr(.DisplayName, "OWAScratch") = 0 _
And InStr(.DisplayName, "Outlook 10") = 0 _
And InStr(.DisplayName, "StoreEvents") = 0 Then
'Add new record to the Access database
objRecordsetDB.AddNew
' Get Folder data from AD and populate the new record in the
' Access database
objRecordsetDB("DisplayName") = .DisplayName
objRecordsetDB("Description") = .sAMAccountname
objRecordsetDB("objectCategory") = .objectCategory
objRecordsetDB("distinguishedName") = .textEncodedORAddress
objRecordsetDB("Email") = .mail
objRecordsetDB("ImportedFromAD") = True
' Commit the record
objRecordsetDB.Update
End If
' Release this object reference
Set objFolder = Nothing
End With
' Move to the next record in the AD recordset
objRecordsetAD.MoveNext
Loop
' Close the Access database recordset
objRecordsetDB.Close
' Close the Access database connection
objConnectionDB.Close
' Release these object references
Set objRecordsetDB = Nothing
Set objConnectionDB = Nothing
' Close the AD recordset
objRecordsetAD.Close
' Close the AD connection
objConnectionAD.Close
' Release these object references
Set objRecordsetAD = Nothing
Set objConnectionAD = Nothing
' Delete Empty entries
DoCmd.RunSQL "DELETE FROM ADEmailAdressen WHERE Trim(nz(DisplayName)) = ''"
End Function
Die Routine ist noch im Test und enthält deshalb überflüssigen/nicht optimierten Code.
Hierbei erhalte ich den Ordnernamen allerdings nicht in seiner Baumstruktur. Ein Ordner
Öffentliche Ordner\Alle öffentlichenOrdner\Testordner\Unterordner1 wird nur mit dem Namen Unterordner1 ausgegeben.
Gruß Jehemo2001
In ordner, öffentliche Ordner rechte Maustatste auf den Ordner, alle Tasks und dann Email aktivieren.
zu 2:
ich lese das AD wie folgt aus:
Function ReadAD()
On Error Resume Next
Const AccessTable = "ADEmailadressen"
' List of Folders who should NOT be exported
' This list should contain the Folder's logon name
' Separate each name by a comma
Const Folders2Skip = ""
' Constant for the search to search subtrees
Const ADS_SCOPE_SUBTREE = 2
Const adOpenStatic = 3
Const adLockOptimistic = 3
' General variable declarations
Dim objConnectionDB As Database
Dim objRecordsetDB As Recordset
Dim objConnectionAD, objCommandAD, objRecordsetAD
Dim strSQL
Dim objRootDSE, strDNSDomain
Dim strDN, strDisplayName
Dim objFolder
Dim i
'Create and open ADO connection to the Access database
Set objConnectionDB = CurrentDb
Set objRecordsetDB = objConnectionDB.OpenRecordset("ADEmailAdressen", dbOpenTable)
' Define the SQL statement used to clear out previous
' Folder info which was exported from AD
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM ADEmailAdressen WHERE ImportedFromAD = True"
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP:RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Create and open an ADO connection to AD
Set objConnectionAD = CreateObject("ADODB.Connection")
Set objCommandAD = CreateObject("ADODB.Command")
objConnectionAD.Provider = "ADsDSOObject"
objConnectionAD.Open "Active Directory Provider"
' Set connection properties
With objCommandAD
.ActiveConnection = objConnectionAD
' Use SQL syntax for the query
' This retrieves all values named in the SELECT section for
' Folder accounts which do not have the Notes section = NoExport.
' The recordset is sorted ascending on the displayName value.
.CommandText = "Select distinguishedName, name, ObjectClass," & _
" displayName, msExchHideFromAddressLists, givenname, sn, cn, mail, " & _
" sAMAccountname, displayName, textEncodedORAddress" & _
" FROM 'LDAP:" & strDNSDomain & "'" & _
" WHERE objectCategory = 'person' AND objectClass='user' OR" & _
" objectCategory='publicFolder' or objectCategory='group' OR" & _
" objectCategory='contact' OR objectCategory='msExchDynamicDistributionList'" & _
" ORDER BY displayName"
' "distinguishedName,name,ObjectClass,LegacyExchangeDN,msExchADCGlobalNames," & _
' "displayName,msExchHideFromAddressLists,hideDLMembership,msexchmasteraccountsid," & _
' "msExchALObjectVersion,showInAddressBook,msExchPolicyEnabled,givenName,sn,cn,mailNickname,targetAddress,proxyAddresses," & _
' "mail,textEncodedORAddress,msExchHomeServerName,msExchExpansionServerName,msExchCustomProxyAddresses,msExchPoliciesIncluded," & _
' "msExchPoliciesExcluded,homeMDB,homeMTA,msExchMailboxGuid,unmergedAtts,msExchDynamicDLFilter,msExchPurportedSearchUI," & _
' "msExchMailboxSecurityDescriptor,msExchResourceGUID,UserAccountControl,msExchUserAccountControl
.Properties("Page Size") = 1000
.Properties("Timeout") = 30
.Properties("Searchscope") = ADS_SCOPE_SUBTREE
.Properties("Cache Results") = False
End With
Set objRecordsetAD = objCommandAD.Execute
' Move to the first record in the recordset
objRecordsetAD.MoveFirst
' Loop until we reach the end of the recordset
Do While Not objRecordsetAD.EOF
' Get the distinguished name of this folder
' The syntax is something like:
' CN=Joe E. Law,OU=Sales,OU=US,DC=mydomain,DC=local
strDN = objRecordsetAD.Fields("distinguishedName")
' Bind to the user object
Err.Clear
Set objFolder = GetObject("LDAP://" & strDN & "")
With objFolder
If Err.Number = 0 And _
Not IsNull(.DisplayName) And Trim(.DisplayName) <> "" And Not IsNull(.mail) And Trim(.mail) <> "" _
And InStr(.DisplayName, "SystemMailbox") = 0 _
And InStr(.DisplayName, "OWAScratch") = 0 _
And InStr(.DisplayName, "Outlook 10") = 0 _
And InStr(.DisplayName, "StoreEvents") = 0 Then
'Add new record to the Access database
objRecordsetDB.AddNew
' Get Folder data from AD and populate the new record in the
' Access database
objRecordsetDB("DisplayName") = .DisplayName
objRecordsetDB("Description") = .sAMAccountname
objRecordsetDB("objectCategory") = .objectCategory
objRecordsetDB("distinguishedName") = .textEncodedORAddress
objRecordsetDB("Email") = .mail
objRecordsetDB("ImportedFromAD") = True
' Commit the record
objRecordsetDB.Update
End If
' Release this object reference
Set objFolder = Nothing
End With
' Move to the next record in the AD recordset
objRecordsetAD.MoveNext
Loop
' Close the Access database recordset
objRecordsetDB.Close
' Close the Access database connection
objConnectionDB.Close
' Release these object references
Set objRecordsetDB = Nothing
Set objConnectionDB = Nothing
' Close the AD recordset
objRecordsetAD.Close
' Close the AD connection
objConnectionAD.Close
' Release these object references
Set objRecordsetAD = Nothing
Set objConnectionAD = Nothing
' Delete Empty entries
DoCmd.RunSQL "DELETE FROM ADEmailAdressen WHERE Trim(nz(DisplayName)) = ''"
End Function
Die Routine ist noch im Test und enthält deshalb überflüssigen/nicht optimierten Code.
Hierbei erhalte ich den Ordnernamen allerdings nicht in seiner Baumstruktur. Ein Ordner
Öffentliche Ordner\Alle öffentlichenOrdner\Testordner\Unterordner1 wird nur mit dem Namen Unterordner1 ausgegeben.
Gruß Jehemo2001