SCMLife.com

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 10016|回复: 2

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

[复制链接]
发表于 2011-4-2 11:21:08 | 显示全部楼层 |阅读模式
ad没有现成的方法导出用户的电子邮件地址。我以前都是在project server中导出,比较麻烦,曲线救国,可以满足需要。最近有人问我怎样导出,我看了些资料,自己写了个脚本。大家拍砖. x) p/ W# n+ J
Set objCommand =   CreateObject("ADODB.Command"): ?# [$ S9 k! v
Set objConnection = CreateObject("ADODB.Connection")7 E5 u, ~, y& U' ], I/ j
objConnection.Provider = "ADsDSOObject"
- }% |5 P- g2 q- x4 `: T8 TobjConnection.Open "Active Directory Provider"& E: `! H6 i9 |$ o5 x2 S
Set objCommand.ActiveConnection = objConnection7 m4 t- z# ?) m  V! k" d
objCommand.CommandText =  "SELECT distinguishedName,userPrincipalName FROM 'LDAP://OU=软件部,OU=xxxx,DC=xxx,DC=xxxx' WHERE objectCategory='user' " 4 D1 N( @1 c8 i! f  i
Set objRecordSet = objCommand.Execute
( @, N" v/ w. c; O) A2 u7 h+ }3 z        objRecordSet.MoveFirst' j) Y- S6 H  ]4 [7 s6 h% V( m3 r, g
  Set xlsApp = CreateObject("Excel.Application")
  C. F3 ~7 D: m) nset newBook = xlsApp.Workbooks.Add
! p: q- n! D: ~9 _3 x9 I6 ewith newBook: a# `) e; e2 Z4 C
        .Title = "email"
: r% @3 Y/ x1 E$ s( Y        .Subject = "email address"4 C9 b4 z) t) b1 o2 N, J$ K8 j3 d1 R' W  b
        .Activate
1 }" a0 c; N( ]+ P: _) D+ c0 ^& ]End With9 l* B9 @3 q# U. ]
' work with sheet1
8 ]) @- N/ t* oSet newSheet = newBook.Worksheets("Sheet1")
7 C& G( x! C3 F  D8 }newSheet.Visible = True
" m$ j" D2 o' V& l7 UnewSheet.Name = "邮件信息"% ]3 A+ U, H/ S
' set column title
: y. i/ L; h( ~5 ?- ynewSheet.Range("A1:C1").Value = Array("姓名","邮件地址","OU"); z: l9 l% y# W. d
newSheet.Range("A1:C1").Font.Bold = True1 l4 D* j0 _+ `& t
newSheet.Range("A1:C1").wraptext=true ) Y$ E4 A( K+ {4 W3 i( ]
newSheet.Range("A1:C1").Font.Size = "11"9 g8 o. O  s# n/ p( n5 v# a3 v
Dim i) `3 c. o1 V0 B7 V' O
i=2
$ ~+ I2 ^# ^5 J% G        Do Until objRecordSet.EOF- ?+ b0 p. {4 s* x; d
            arrDN = objRecordSet.Fields("distinguishedName").Value
8 I8 X" t% H6 t            arrDN2 = objRecordSet.Fields("userPrincipalName").Value
; f( T: X( }, o' E& O/ O5 A objInfo = Split(arrDN,",")
) X& x9 [5 c8 O! F+ `$ \objInfo2 = Split(objInfo(0),"=")
9 w# R  n0 e' y. y- F4 eobjInfo3 = Split(objInfo(1),"=")
! k, i% K, N9 c2 p; n'MsgBox arrDN21 T+ N$ |# e) O
'MsgBox arrDN
8 L$ o* B5 @- d% l' ?" x7 o            If IsArray(arrDN) = True Then
+ b/ p  A9 A! L* S- N: @! r                    WScript.Echo strUserDisplayName* D$ l0 X) f( F& K  K
                    FindUserDN = arrDN(0)8 v/ d: w5 W% X$ y
            Else
- B7 ^9 \. R1 w3 D                    FindUserDN = arrDN. ]1 M" S  u! y3 u/ y
            End if( Y% A2 ?4 A0 e6 p
            objRecordSet.MoveNext2 s* I+ W4 A! I( k: V1 L
newSheet.Cells(i,1).Value = objInfo2(1)( H5 K! f+ x# U
  newSheet.Cells(i,2).Value =arrDN2- N$ d0 b7 J' ?* B
  newSheet.Cells(i,3).Value = objInfo3(1); {0 g+ U# A  ~' f: n
newSheet.Columns(1).ColumnWidth=10
- ?3 C6 o9 R  ]8 q( p: a0 Z$ E, |newSheet.Columns(2).ColumnWidth=25 $ K' j& v/ Q9 A; ^  n' t2 G" w8 K
newSheet.Columns(1).Font.Size = "10"
: M; k( t- E  P( |i=i+1
5 ^; A# y! Z  {' y2 F$ v' ~; c8 B        Loop
$ d. U0 q1 \1 |0 ~! \2 {( n& H        If Err.Number <> 0 Then" c- |' u( U- [: Y- O
                WScript.Echo Err.Description & ":" & strUserDisplayName
, j% i3 D& c: S8 i                Err.Clear5 V- f. {4 G( s9 A( ?0 S/ r4 m
        End If        
* c/ e7 ~! U, _( _2 Ms=date" V6 a7 v5 H' y0 ^0 F
' Save changes to the excel; p. p" y3 @! s# Z
newBook.SaveAs("c:\导出ad信息.xls"): q9 H# h4 R9 l$ k
' release the objects
0 _' O# W9 z% c/ e) j. m% n& mSet newsheet=Nothing
* `: h( |. M+ @9 H& aMsgBox "导出成功到C盘", V. J! U+ O6 r5 {

本帖被以下淘专辑推荐:

发表于 2012-10-12 13:47:32 | 显示全部楼层
mark
4 y5 \% Q9 V$ d. h' {. J9 w) y9 h/ T) t: d7 O
好东西啊、先收藏了。说不定哪天就能用到的
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

本版积分规则

关闭

SCMLife推荐上一条 /4 下一条

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

GMT+8, 2019-4-24 02:53 , Processed in 0.058852 second(s), 8 queries , Gzip On, MemCache On.

Powered by SCMLife X3.4 Licensed

© 2001-2017 JoyShare.

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