SCMLife.com

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 9182|回复: 2

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

[复制链接]
发表于 2011-4-2 11:21:08 | 显示全部楼层 |阅读模式
ad没有现成的方法导出用户的电子邮件地址。我以前都是在project server中导出,比较麻烦,曲线救国,可以满足需要。最近有人问我怎样导出,我看了些资料,自己写了个脚本。大家拍砖
  B8 a5 I' B3 y1 OSet objCommand =   CreateObject("ADODB.Command")! |, k4 e4 G, s# t
Set objConnection = CreateObject("ADODB.Connection"); w5 u; g. U6 ~# y* k# ]
objConnection.Provider = "ADsDSOObject"# U" u) F/ y  N6 w- l0 e; p+ u
objConnection.Open "Active Directory Provider"
- H8 m8 M; ]2 C7 a- h) z7 s, E2 nSet objCommand.ActiveConnection = objConnection
- r' z3 \: H$ a. j objCommand.CommandText =  "SELECT distinguishedName,userPrincipalName FROM 'LDAP://OU=软件部,OU=xxxx,DC=xxx,DC=xxxx' WHERE objectCategory='user' " , ^2 z, `  y8 y1 _: P$ t; N
Set objRecordSet = objCommand.Execute
2 ^6 E/ t' i1 M  L2 M) v8 K        objRecordSet.MoveFirst
/ {* b. R, ~. x/ ?# F# F  Set xlsApp = CreateObject("Excel.Application")
1 \$ l! U3 s: |9 cset newBook = xlsApp.Workbooks.Add9 H# \* ?- v7 }1 k
with newBook7 e, c, V, e5 V4 f2 X9 S8 R; m9 w$ I9 X! i
        .Title = "email"; b5 y% F1 o$ m+ Q& t& o& K
        .Subject = "email address"
& ]- F; t2 ?$ x        .Activate
' O8 t1 j5 U( w2 L, hEnd With* ^3 H. x0 D4 }, n  {5 v
' work with sheet1- A, Q, A1 Z( }7 q
Set newSheet = newBook.Worksheets("Sheet1")
+ J9 f$ f8 I4 j" Z* KnewSheet.Visible = True
1 w. H& i9 o0 Y% q- N1 k' `' unewSheet.Name = "邮件信息"
% ]8 ]4 Y: Z% E& r( ^' set column title
2 D8 D9 s: Y$ a- S" [7 mnewSheet.Range("A1:C1").Value = Array("姓名","邮件地址","OU")
0 ~2 g7 m8 ^0 M) pnewSheet.Range("A1:C1").Font.Bold = True. E: r2 {3 K6 M! c; F
newSheet.Range("A1:C1").wraptext=true $ U: M% @+ K+ [- v9 V
newSheet.Range("A1:C1").Font.Size = "11"
- s" s( y  y7 Y- [5 _  d# UDim i
8 J0 s- J' W% J  |0 {* ti=2
. W4 H) Y$ C8 v3 K5 g) \4 P, i6 v        Do Until objRecordSet.EOF) t- w2 e: ~& I
            arrDN = objRecordSet.Fields("distinguishedName").Value
! o2 _9 z4 ]% S/ j            arrDN2 = objRecordSet.Fields("userPrincipalName").Value
/ r1 u# g3 F4 r3 B; V) \ objInfo = Split(arrDN,",")
9 p. J+ o3 a3 z. k. q- hobjInfo2 = Split(objInfo(0),"=")
% _- e4 ~# V4 k6 OobjInfo3 = Split(objInfo(1),"=")/ n& A& u* ^2 e3 R9 x( V6 }5 o. @
'MsgBox arrDN2
/ C5 l6 Y: K0 o6 a/ r+ s& v2 `8 Q'MsgBox arrDN
* ~' C4 t9 p, x; N/ F            If IsArray(arrDN) = True Then* b+ _7 H9 V! J* [# W- }
                    WScript.Echo strUserDisplayName: K5 ^$ E. |0 W, n
                    FindUserDN = arrDN(0)! r0 Z) W3 y  b# S5 z$ O" u
            Else
9 w% G- l3 B* e                    FindUserDN = arrDN$ G+ o! L; ?  O
            End if
, n+ a! u8 Y' Z: ]( H* t$ x" v            objRecordSet.MoveNext7 N9 @( d/ ^2 z1 Z1 T
newSheet.Cells(i,1).Value = objInfo2(1): k  n. z" N+ r9 V* ~. B
  newSheet.Cells(i,2).Value =arrDN2; o1 h8 K. b* ^6 o' Z' _+ U! l
  newSheet.Cells(i,3).Value = objInfo3(1), c% V6 W3 r3 l* D( j3 n
newSheet.Columns(1).ColumnWidth=10 1 b2 t  \- Q. f# `9 G) W- F0 D
newSheet.Columns(2).ColumnWidth=25 4 K, K0 x  ^8 L& V+ ?
newSheet.Columns(1).Font.Size = "10"  n, x% o! f8 R! h# C
i=i+1  t, \. Z' ~9 k3 j
        Loop
+ J3 Q6 |7 J$ K) @        If Err.Number <> 0 Then- @! t! j% z8 Z; `. F
                WScript.Echo Err.Description & ":" & strUserDisplayName) p" Y/ x: P0 h+ E" n
                Err.Clear
. w( b0 j; {0 R& T        End If        5 N' x; l$ ]8 U
s=date6 i$ A. y: c0 C" w7 s! r8 f5 W) B
' Save changes to the excel; |( [$ b8 x# m9 b2 u
newBook.SaveAs("c:\导出ad信息.xls")3 {. _% b: f+ e' y6 G& D
' release the objects, [2 `, O! X  g: [2 P9 u
Set newsheet=Nothing) x: u  h  t  q$ a+ s' |" P5 M* d
MsgBox "导出成功到C盘"
# r. F6 Y% U1 D

本帖被以下淘专辑推荐:

发表于 2012-10-12 13:47:32 | 显示全部楼层
mark' @) D& j2 T( Y& }  g4 Z- S* O
1 k9 x4 p1 T: U; c$ ]
好东西啊、先收藏了。说不定哪天就能用到的
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

本版积分规则

关闭

SCMLife推荐上一条 /4 下一条

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

GMT+8, 2018-9-19 23:38 , Processed in 0.065590 second(s), 7 queries , Gzip On, MemCache On.

Powered by SCMLife X3.4 Licensed

© 2001-2017 JoyShare.

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