Čo sa myslí pod skratkou AD?citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Tipy a triky pro Excel a makra VBA
< návrat zpět
Téma: Šablona, která načte do polí informace z AD
MS Excel
Téma: Šablona, která načte do polí informace z AD 
Zaslal/a 21.2.2012 22:15
Mohli byste mi poradit, jak mám vytvořit šablonu v Excelu využívající doplněk xla, který jsem si vytvořil. Tento doplněk dokáže načítat data z AD o aktuálně přihlášeném uživateli. Je nainstalovaný a přístupný pro každého přihlášeného uživatele. Když vytvořím šablonu využívající tento doplněk a chce ji použít jiný uživatel, je ve vzorcích relativní cesta k doplňku uživatele, který šablonu tvořil, tudíž by každý musel odmazávat relativní cesty a uložit si soubor pro sebe. Toto pak postrádá kouzlo, kterého jsem chtěl docílit, a to jedné šablony, do které se doplňují informace z AD podle toho, kdo je zrovna přihlášený. Děkuji za návrhy
Tipoval bych Active Directory. Když to ale nevidím, tak nevím jak to vypadá, ale nešlo by makrem prostě přepisovat cestu dle aktuálně přihlášeného uživatele?
který jde zjistit třeba přes:
VBA.Environ("USERNAME")
nebo ve vzorcích použít nepřímý.odkaz.
M@citovat
který jde zjistit třeba přes:
VBA.Environ("USERNAME")
nebo ve vzorcích použít nepřímý.odkaz.
M@citovat
(22.2.2012 20:00)#007390
Tuhle funkci používám při zjišťování uživatele celý kód xla je tento:
Function GetEnvirons(ByVal ArgumentName As String) As String
On Error GoTo Env_Err
GetEnvirons = Environ(ArgumentName)
Exit Function
Env_Err:
GetEnvirons = ""
End Function
Function GetAdsProp(ByVal SearchField As String, ByVal ReturnField As String) As String
' Get the domain string ("dc=domain, dc=local")
Dim strDomain As String
strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
' ADODB Connection to AD
Dim objConnection As ADODB.Connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
' Connection
Dim objCommand As ADODB.Command
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
' Get the logged user
Dim SearchUser As String
SearchUser = GetEnvirons("USERNAME")
' Search the AD recursively, starting at root of the domain
objCommand.CommandText = _
"<LDAP://" & strDomain & ">;(&(objectCategory=User)" & _
"(" & SearchField & "=" & SearchUser & "));" & SearchField & "," & ReturnField & ";subtree"
' RecordSet
Dim objRecordSet As ADODB.Recordset
Set objRecordSet = objCommand.Execute
If objRecordSet.RecordCount = 0 Then
GetAdsProp = "not found" ' no records returned
Else
GetAdsProp = objRecordSet.Fields(ReturnField) ' return value
End If
' Close connection
objConnection.Close
' Cleanup
Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
End Function
použití je takto:
=GetAdsprop(“cn”; A2; “samAccountName”)
Když vytvořím šablonu, do které dám tento vzorec, tak po otevření jiným uživatelem doplní Excel ke vzorci absolutní cestu k doplňku tvůrce šablony. Všichni uživatelé mají doplněk nainstalovaný a museli by si každou položku s tímto vzorcem upravit, aby byla bez cesty a uložit jako svou šablonu. To ale ztrácí to kouzlo, kterého chci docílit. A to je, že uživatel klepne na excelovou šablonu a ve vybraných buňkách bude mít napsané informace o sobě načtené z Active directory.citovat
Function GetEnvirons(ByVal ArgumentName As String) As String
On Error GoTo Env_Err
GetEnvirons = Environ(ArgumentName)
Exit Function
Env_Err:
GetEnvirons = ""
End Function
Function GetAdsProp(ByVal SearchField As String, ByVal ReturnField As String) As String
' Get the domain string ("dc=domain, dc=local")
Dim strDomain As String
strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
' ADODB Connection to AD
Dim objConnection As ADODB.Connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
' Connection
Dim objCommand As ADODB.Command
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
' Get the logged user
Dim SearchUser As String
SearchUser = GetEnvirons("USERNAME")
' Search the AD recursively, starting at root of the domain
objCommand.CommandText = _
"<LDAP://" & strDomain & ">;(&(objectCategory=User)" & _
"(" & SearchField & "=" & SearchUser & "));" & SearchField & "," & ReturnField & ";subtree"
' RecordSet
Dim objRecordSet As ADODB.Recordset
Set objRecordSet = objCommand.Execute
If objRecordSet.RecordCount = 0 Then
GetAdsProp = "not found" ' no records returned
Else
GetAdsProp = objRecordSet.Fields(ReturnField) ' return value
End If
' Close connection
objConnection.Close
' Cleanup
Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
End Function
použití je takto:
=GetAdsprop(“cn”; A2; “samAccountName”)
Když vytvořím šablonu, do které dám tento vzorec, tak po otevření jiným uživatelem doplní Excel ke vzorci absolutní cestu k doplňku tvůrce šablony. Všichni uživatelé mají doplněk nainstalovaný a museli by si každou položku s tímto vzorcem upravit, aby byla bez cesty a uložit jako svou šablonu. To ale ztrácí to kouzlo, kterého chci docílit. A to je, že uživatel klepne na excelovou šablonu a ve vybraných buňkách bude mít napsané informace o sobě načtené z Active directory.citovat
Takže si vlastně pomocí funkce hrábne do databáze a pod daným uživatelem vrátí požadovanou hodnotu dle A2, či jiných.
A po spuštění pod jiným uživatelem vzorec:
=GetAdsprop(“cn”; A2; “samAccountName”)
vypadá jinak?
Co po spuštění projet makrem dané buňky a přepsat ty vzorce tak aby byly bez cesty - víc asi nevymyslím :-/
M@citovat
A po spuštění pod jiným uživatelem vzorec:
=GetAdsprop(“cn”; A2; “samAccountName”)
vypadá jinak?
Co po spuštění projet makrem dané buňky a přepsat ty vzorce tak aby byly bez cesty - víc asi nevymyslím :-/
M@citovat
(22.2.2012 22:24)#007396
Jinak ten vzorec je samozřejmě bez toho A2 to mi tam ulítlo. Funkce GetAdsProp má jen dva parametry "cn" a položku z AD pro dané políčko např. mailcitovat
K tomu by bylo dobré vidět ten vzorec před a po.
Makro by mohlo zkontrolovat konkrétní buňky nebo třeba univerzálně nějakou oblast.
Provest kontrolu
if left(cell.formula,11)="=GetAdsprop" then cell.formula = xxxx (dle potřeby)
nebo třeba zkontrolovat jednu konkrétní buňku, kdy zjistíš co si excel dosadil navíc a pak to hromadně pomocí Cells.Replace třeba odstranit.
M@citovat
Makro by mohlo zkontrolovat konkrétní buňky nebo třeba univerzálně nějakou oblast.
Provest kontrolu
if left(cell.formula,11)="=GetAdsprop" then cell.formula = xxxx (dle potřeby)
nebo třeba zkontrolovat jednu konkrétní buňku, kdy zjistíš co si excel dosadil navíc a pak to hromadně pomocí Cells.Replace třeba odstranit.
M@citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nFormulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články