SCMLife.com

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 8775|回复: 2

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

[复制链接]
发表于 2011-4-2 11:21:08 | 显示全部楼层 |阅读模式
ad没有现成的方法导出用户的电子邮件地址。我以前都是在project server中导出,比较麻烦,曲线救国,可以满足需要。最近有人问我怎样导出,我看了些资料,自己写了个脚本。大家拍砖. c; c1 ~* r8 f1 J
Set objCommand =   CreateObject("ADODB.Command")/ @6 Z9 N3 Y4 L- i8 G" x8 d/ Z9 |
Set objConnection = CreateObject("ADODB.Connection")3 R, V7 W- p. x) p4 z' ]
objConnection.Provider = "ADsDSOObject"
: h* }' G4 n, N9 `: f; W5 r3 wobjConnection.Open "Active Directory Provider"9 a/ C, o* h  f+ z8 s; S
Set objCommand.ActiveConnection = objConnection# L) r9 _2 x8 u8 Y5 {
objCommand.CommandText =  "SELECT distinguishedName,userPrincipalName FROM 'LDAP://OU=软件部,OU=xxxx,DC=xxx,DC=xxxx' WHERE objectCategory='user' " * L0 Q6 D3 \' `; v0 Y1 ?  X
Set objRecordSet = objCommand.Execute
+ G7 y9 |6 {1 a. ~1 \8 J        objRecordSet.MoveFirst
  R& @/ z, K( P! R) I8 G( V4 {4 |8 U  Set xlsApp = CreateObject("Excel.Application")9 ~! h& K1 ^0 T) L" q$ ]6 l
set newBook = xlsApp.Workbooks.Add7 T2 [6 F2 T) |2 T
with newBook5 e9 Q! x7 r) G/ t$ Y- F9 D% n
        .Title = "email"
* g7 V# R4 H  o5 n        .Subject = "email address"' t: T5 ?; a8 i/ G) k" B
        .Activate
% T7 z# V- g/ tEnd With, A; G3 Q! R) F8 T" v+ `7 c
' work with sheet1
9 `# B$ w& g6 m: F8 Z. [, D" {Set newSheet = newBook.Worksheets("Sheet1")
+ G0 [" {  |% R+ j# w/ e+ enewSheet.Visible = True
0 I+ X  @/ E. J: ?* C, lnewSheet.Name = "邮件信息"( E8 m0 {- i9 m6 s* E
' set column title5 j3 c+ t; x  Y
newSheet.Range("A1:C1").Value = Array("姓名","邮件地址","OU")! ~7 m4 n# l2 M& T. i- x, q+ U# Q
newSheet.Range("A1:C1").Font.Bold = True
2 M: {! F& E: m+ UnewSheet.Range("A1:C1").wraptext=true 4 d( [. A+ M$ U* A( ?4 \" X' F
newSheet.Range("A1:C1").Font.Size = "11"1 ?0 c( B3 G. r- N# c
Dim i6 ?$ S7 Y% G$ P# C
i=2
' `5 Y, u$ ~# J, H; G1 F& y1 q7 i        Do Until objRecordSet.EOF
# Y0 x6 a" T0 p/ L            arrDN = objRecordSet.Fields("distinguishedName").Value
: ^5 P& a6 m3 h! Y* b9 L            arrDN2 = objRecordSet.Fields("userPrincipalName").Value4 f2 x5 G9 A0 Q+ ?, v# J
objInfo = Split(arrDN,","). K9 G( I1 g/ ~5 m" Z5 d
objInfo2 = Split(objInfo(0),"=")
# A5 \. X$ i7 XobjInfo3 = Split(objInfo(1),"=")
' z0 \3 ]* i1 l% ^  Z. o, x  r'MsgBox arrDN20 N( M* a+ B) ]3 J2 P/ p
'MsgBox arrDN
  x, K! M9 N$ N% ^. P0 Y$ x: m            If IsArray(arrDN) = True Then4 J. D2 q8 }3 ]: f' @4 f9 @
                    WScript.Echo strUserDisplayName
/ ~$ V# N, D" ^$ C* i0 K! q0 K                    FindUserDN = arrDN(0)
# y, [- _$ k" U6 f6 p            Else
6 M( {1 F( I$ t! \                    FindUserDN = arrDN
1 ^( o; K* v+ m7 F! j( x* V            End if
  ~' _2 ]- M+ ?$ m6 b            objRecordSet.MoveNext
( D4 ?- Y& T: F3 v# a8 y5 n7 C newSheet.Cells(i,1).Value = objInfo2(1)
" H! u: j7 S6 H7 v  newSheet.Cells(i,2).Value =arrDN2: f% H5 G8 b9 [
  newSheet.Cells(i,3).Value = objInfo3(1)
; l6 R, i6 M. T& enewSheet.Columns(1).ColumnWidth=10
8 m. c( m( M* B$ qnewSheet.Columns(2).ColumnWidth=25
9 E7 N7 [4 a7 w, V5 g; N+ LnewSheet.Columns(1).Font.Size = "10"
. j  w+ b' n# `+ j' |i=i+1
; {) D) S8 n$ W7 h6 Z, L& X        Loop
; v/ F; Q' ~; W. I' Z        If Err.Number <> 0 Then# Q- K* X% y) x! m
                WScript.Echo Err.Description & ":" & strUserDisplayName3 i" J) K5 B1 x& o  a5 \  |0 B
                Err.Clear
+ _1 ?8 o; C, T& g8 J        End If        ( @  L+ V1 v4 P. I7 ~* }5 `
s=date8 p; V9 s+ t7 \6 {) J
' Save changes to the excel  j8 X1 P! ]. D
newBook.SaveAs("c:\导出ad信息.xls")) T9 [2 B' C: o; Y
' release the objects* [, n! l2 H, ?7 j
Set newsheet=Nothing% e. k: x1 W0 I1 G
MsgBox "导出成功到C盘"
+ B* w4 O: W) }& E0 `9 r6 s

本帖被以下淘专辑推荐:

发表于 2012-10-12 13:47:32 | 显示全部楼层
mark1 F  T+ ~, `: G; Y% T' m
. ~* j3 w+ o6 @. v/ N& \5 U
好东西啊、先收藏了。说不定哪天就能用到的
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2018-5-21 11:08 , Processed in 0.054642 second(s), 7 queries , Gzip On, MemCache On.

Powered by SCMLife X3.4 Licensed

© 2001-2017 JoyShare.

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