SCMLife.com

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 9655|回复: 2

[原创] 从ad里导出电子邮件地址

[复制链接]
发表于 2011-4-2 11:21:08 | 显示全部楼层 |阅读模式
ad没有现成的方法导出用户的电子邮件地址。我以前都是在project server中导出,比较麻烦,曲线救国,可以满足需要。最近有人问我怎样导出,我看了些资料,自己写了个脚本。大家拍砖4 D" e8 }) }* d
Set objCommand =   CreateObject("ADODB.Command")
: s4 C* j8 ?; L5 cSet objConnection = CreateObject("ADODB.Connection")1 _% |" y/ j/ u
objConnection.Provider = "ADsDSOObject"
. B4 z! C& ~  ?  [& M# aobjConnection.Open "Active Directory Provider"
  X- L- C; Y. r/ ~3 i/ I  V; cSet objCommand.ActiveConnection = objConnection
% b# G9 Z% X) S. |8 a3 i8 W9 B objCommand.CommandText =  "SELECT distinguishedName,userPrincipalName FROM 'LDAP://OU=软件部,OU=xxxx,DC=xxx,DC=xxxx' WHERE objectCategory='user' " % h1 z  \6 G* @0 ]2 n
Set objRecordSet = objCommand.Execute. p7 _# A, y/ a
        objRecordSet.MoveFirst2 ^. e# ?; d: Z( {& k
  Set xlsApp = CreateObject("Excel.Application")/ z. J6 d4 r/ S8 y4 l
set newBook = xlsApp.Workbooks.Add
( L3 {* ?) k) p: m1 H1 a# j+ Y* Nwith newBook
9 d5 ]3 j# ~8 B        .Title = "email"
! ~* q; r7 D1 b2 z8 H        .Subject = "email address"
9 ^' D& T* Z( _) q4 ~; M        .Activate
% {$ d& q9 o. SEnd With/ a( T- B7 T1 |" B4 G( j
' work with sheet1% W3 _3 h% d3 G1 M! N8 {# z& h
Set newSheet = newBook.Worksheets("Sheet1"); ~6 A* E! E$ |
newSheet.Visible = True
0 ?2 s0 z; a2 s9 O" B' C! FnewSheet.Name = "邮件信息"/ E5 B2 a- C4 }0 e; o; a" Y$ d
' set column title. W" G  ]7 Q& l. K  b0 L4 E
newSheet.Range("A1:C1").Value = Array("姓名","邮件地址","OU")" u; b) ~3 ]5 V" ]
newSheet.Range("A1:C1").Font.Bold = True
+ T6 \6 b' H, Y+ J6 b# K' a, snewSheet.Range("A1:C1").wraptext=true   k& k7 K, |+ f5 ?4 w2 i, @
newSheet.Range("A1:C1").Font.Size = "11"1 k3 n. x/ h7 ]
Dim i
4 W& I5 u& l( V7 i7 ]- O! \- y' gi=2
& L* a, g; L1 i' j- `        Do Until objRecordSet.EOF6 |6 b) V6 B' i* x% R
            arrDN = objRecordSet.Fields("distinguishedName").Value
8 V# H: J. `8 G- b% t" v            arrDN2 = objRecordSet.Fields("userPrincipalName").Value
2 \7 H/ e( y' I1 l$ P/ m objInfo = Split(arrDN,",")/ i5 G/ X) g/ V2 f$ e# L0 ~
objInfo2 = Split(objInfo(0),"="): H2 x" I" J( Q7 H7 i; i3 [
objInfo3 = Split(objInfo(1),"=")
  q* w4 m0 q3 p! j'MsgBox arrDN2  g1 u) w) c$ z8 ]
'MsgBox arrDN# {! T! y4 i2 x/ o0 b7 i& P3 t
            If IsArray(arrDN) = True Then
% }0 S/ K6 K9 p$ G% T& f6 Y' B                    WScript.Echo strUserDisplayName
% Y( l' S4 Y- i+ C, L+ N                    FindUserDN = arrDN(0)
4 `" d! @2 K$ p            Else# |5 Z! p2 U1 X. {" p9 K/ _0 u# E  g* g! L
                    FindUserDN = arrDN! P: V& o. k5 J8 {) i# Z
            End if
5 h8 _; a# V1 Q& T, n/ t+ t4 p4 E            objRecordSet.MoveNext
9 |1 x. ]( M) P9 {0 } newSheet.Cells(i,1).Value = objInfo2(1). t! m( ~! h5 w! b3 L
  newSheet.Cells(i,2).Value =arrDN2/ _: u9 r" H, \$ Q+ h! r
  newSheet.Cells(i,3).Value = objInfo3(1)
9 N0 O: b: k" q3 w7 DnewSheet.Columns(1).ColumnWidth=10 2 W" ]/ B* E9 g/ B
newSheet.Columns(2).ColumnWidth=25 5 G* B! R- `3 q$ P  h4 F
newSheet.Columns(1).Font.Size = "10"  C0 M/ k  e$ a$ x
i=i+1
* n7 w" d2 l' M" i5 i  y        Loop
" r3 g+ c! c& [- v7 m; ^$ L, F) K        If Err.Number <> 0 Then
5 c3 N4 r! R# R2 n/ k; H' b                WScript.Echo Err.Description & ":" & strUserDisplayName
2 p' u, b' e. [' U* Y7 H6 z$ i9 K. Q                Err.Clear
8 T5 R3 j" E" ~* ^3 |" e  \        End If        
4 ?$ z! f9 ]/ Ps=date
5 B+ H$ j$ \/ j8 d' Save changes to the excel' w; j6 r3 k: E5 T
newBook.SaveAs("c:\导出ad信息.xls")1 W1 F+ m* [7 y  v, d& R
' release the objects$ J9 w, j- d$ G7 s8 W& k: G
Set newsheet=Nothing1 ~( N- t4 b0 J+ c9 Z: N1 K6 a
MsgBox "导出成功到C盘"
( x# t1 y  T; ~' o

本帖被以下淘专辑推荐:

发表于 2012-10-12 13:47:32 | 显示全部楼层
mark9 O2 k$ i0 l1 k& c- X
* f; ~0 C7 ~, P( K
好东西啊、先收藏了。说不定哪天就能用到的
回复 支持 反对

使用道具 举报

发表于 2013-7-29 12:11:01 | 显示全部楼层
路过学习!!!!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

关闭

SCMLife推荐上一条 /4 下一条

QQ|小黑屋|手机版|无图版|SCMLife.com ( 京ICP备06056490号-1 )

GMT+8, 2019-1-22 09:13 , Processed in 0.064165 second(s), 7 queries , Gzip On, MemCache On.

Powered by SCMLife X3.4 Licensed

© 2001-2017 JoyShare.

快速回复 返回顶部 返回列表