[Actual combat two]vbs script export user information to Access database

VBS script Export user information to Access database,

VBS operate ACCDB

Source code is below

=====================================

‘********************************************************
' * Windows Script Source Code *
' *used for Collect PPG China Users PC infromation *
' *author:fu Eric[email protected]*
' *hm Senior IT *
' *date:28 Nov 2013 *
' *any Site can change infor depend on your request *
‘********************************************************
On Error Resume Next

Strldap = "Ldap://ou=cn,ou=users,ou=cn,ou=hm,dc=hm, dc=com"

Const ads_uf_dont_expire_passwd = &h10000
Const ads_uf_accountdisable = 2
Const Ads_acetype_access_denied_object = &h6
Const Change_password_guid = _
"{ab721a53-1e2f-11d0-9819-00aa0040529b}"

Set Usr=getobject (STRLDAP)

For each member in USR

Strutype = Member.class

If strutype = "User" Then

Strid= member.get ("sAMAccountName")

Strdisplayname = Member.displayname

Stroffice = Member.physicaldeliveryofficename

Strtel = member. Get ("telephonenumber")

Strothermobile = member. GetEx ("Othermobile")

For each Item in Strothermobile

STRKEYNUM1 = Item

Strleftstr = Left (strkeynum1,2)

If strleftstr = "AI" Then

Strkeynum = Strkeynum1

Exit for

End If

Next

Item = Null

Strothermobile = Null

STRKEYNUM1 = Null

' ==============================
Strbus = Member.othertelephone

Intuac = member. Get ("userAccountControl")
If Intuac and Ads_uf_accountdisable Then

Straccountstate = "Disable"
Else
Straccountstate= "Enable"

End If

Strdes = Member.description

Strtitle = Member.get ("title")

Striphone = Member.ipphone

' =====get lastlogin time=====

Set Objlastlogon = member. Get ("lastLogonTimestamp")


Strlastlogontimestamp = Objlastlogon.highpart * (2^32) + Objlastlogon.lowpart
Strlastlogontimestamp = Strlastlogontimestamp/(60 * 10000000)
Strlastlogontimestamp = strlastlogontimestamp/1440
Strlastlogontimestamp = Strlastlogontimestamp + #1/1/1601#

Set Objlastlogon = Nothing

Set Objlastlogon1 = member. Get ("Lastlogon")
strLastLogonTime1 = Objlastlogon1.highpart * (2^32) + Objlastlogon1.lowpart
StrLastLogonTime1 = strLastLogonTime1/(60 * 10000000)
StrLastLogonTime1 = strlastlogontime1/1440
strLastLogonTime1 = strLastLogonTime1 + #1/1/1601#
Set Objlastlogon1 = Nothing

strvalue1 = VarType (Strlastlogontimestamp)
Strvalue2 = VarType (strLastLogonTime1)
strstring = strvalue1 & "+" & strvalue2

Strlocallt = DateValue (strLastLogonTime1)
Strremotelt = DateValue (Strlastlogontimestamp)

Select Case strstring
Case "1+7" strllt = strLastLogonTime1
Case "7+1" strllt = Strlastlogontimestamp
Case "strllt" = Null
Case Else If DateDiff ("D", Strlocallt,strremotelt) >=0 Then
Strllt = Strlastlogontimestamp
Else
Strllt = strLastLogonTime1
End If
End Select

If member.mdbusedefaults = False Then

Strstoquota = Member.mdbstoragequota
Strovequota = Member.mdboverquotalimit
Strharquotalim= Member.mdboverhardquotalimit

Strquotamailbox = Strstoquota & "MB" & Strovequota & "MB" & Strharquotalim & "MBytes"

Else

Strquotamailbox = "Default Settings"

End If

' ====mailbox store is strmstore1======
Strmstore = Member.homemdb

Myarray1 = Split (Strmstore, ",", -1,1)

Strmstore1 = Myarray1 (0)

Strmstore = Null

' ====check whether have webmail======
Strmemberof = member. GetEx ("MemberOf")

Strcheck = IsObject (strmemberof)

' WScript.Echo Strcheck

If Strcheck = 0 Then

For each Item1 in Strmemberof

Myarray = Split (Item1, ",", -1,1)

Myarray2 = Split (Myarray (0), "=", -1,1)

' WScript.Echo Myarray2 (1)

If Myarray2 (1) = "Cnsh Webmail users" Or Myarray2 (1) = "Webmail Users" Then

Strwebmail = "Enable"

Exit for
Else
Strwebmail = "Disable"
End If

Next

Else

Strwebmail = "Disable"

End If

Set myarray = Nothing

Set Myarray2 = Nothing

Set Myarray1 = Nothing

' =========
' Strid = CStr (Strid)
' Strdisplayname = CStr (strdisplayname)
' Stroffice = CStr (Stroffice)
' Straccountstate = CStr (straccountstate)
' Strdes = CStr (strdes)
' Strllt = CStr (strllt)
' Strtel = CStr (Strtel)
' Strbus = CStr (Strbus)
' Striphone = CStr (Striphone)
' strtitle = CStr (strtitle)
' Strmstore1 = CStr (strmstore1)
' Strkeynum = CStr (strkeynum)
' Strwebmail = CStr (strwebmail)
' Strquotamailbox = CStr (Strquotamailbox)

' WScript.Echo (Strid & Strdisplayname & Stroffice & straccountstate & Strdes _
' & Strllt & Strtel & Strbus & Striphone & strtitle & Strmstore1 _
' & Strkeynum & Strwebmail & Strquotamailbox)

Call Wsql (Strid)

Wscript.Sleep (1000)

Strid = Null
Strdisplayname = Null
Stroffice = Null
Straccountstate = Null
Strdes = Null
Strllt = Null
Strtel = Null
Strbus = Null
Striphone = Null
Strtitle = Null
Strmstore1 = Null
Strkeynum = Null
Strwebmail = Null
Strquotamailbox = Null

Myarray1 = Null

Myarray = Null

Myarray2 = Null

Set Intuac = Nothing

Set strmemberof = Nothing

Strmstore1 = Null

Strvalue1 = Null
Strvalue2 = Null
strstring = Null

End If

Next

' ======sql Table list====
' UserName Strid
' DisplayName strdisplayname
' Officename Stroffice
' Accountstatus straccountstate
' Description strdes
' Lastlogontime strllt
' Telephone Strtel
' Business2 Strbus
' Ipphone Striphone
' Title strtitle
' Mailstore Strmstore1
' Raskeynumber Strkeynum
' Webmailcheck Strwebmail
' Mailboxquota Strquotamailbox

Sub Wsql (strtemp)

Dim Tempvalue

On Error Resume Next

Const adOpenStatic = 3
Const adLockOptimistic = 3

Set objconnection = CreateObject ("ADODB. Connection ")
Set objRecordSet = CreateObject ("ADODB. Recordset ")

Objconnection.open _
"Provider = microsoft.ace.oledb.12.0;" & _
"Data Source = C:\inetpub\wwwroot\AccountList\Account.accdb"

Objrecordset.open "SELECT * from accountlist where UserName = '" & strtemp& "'", _
Objconnection, adOpenStatic, adLockOptimistic

Objrecordset.movefirst

Do Until objrecordset.eof

Tempvalue = ObjRecordset.Fields.Item ("UserName")

Objrecordset.movenext
Loop

Objrecordset.close
Objconnection.close

Set objconnection = Nothing
Set objRecordSet = Nothing

If Tempvalue = strtemp Then

' WScript.Echo Find It '

Set ObjConnection1 = CreateObject ("ADODB. Connection ")
Set ObjRecordSet1 = CreateObject ("ADODB. Recordset ")

Objconnection1.open _
"Provider = microsoft.ace.oledb.12.0;" & _
"Data Source = C:\inetpub\wwwroot\AccountList\Account.accdb"

Objrecordset1.open "UPDATE accountlist Set DisplayName = '" & Strdisplayname & "', Officename = '" & Stroffice & "', Accountstatus = '" & Straccountstate & "', Description = '" & Strdes & "', Lastlogontime = '" & S Trllt & "', telephone = '" & Strtel & "', Business2 = '" & Strbus & "', Ipphone = '" & Striphone &A MP; "', Title = '" & strtitle & "', Mailstore = '" & Strmstore1 & "', Raskeynumber = '" & Strkeynum &A MP; "', Webmailcheck = '" & Strwebmail & "', Mailboxquota = '" & Strquotamailbox & "'" & _
"Where UserName = '" & strtemp & "'", _
ObjConnection1, adOpenStatic, adLockOptimistic

Objrecordset1.close
Objconnection1.close

Set ObjConnection1 = Nothing
Set ObjRecordSet1 = Nothing

Else

' WScript.Echo ' can ' t find it

Set ObjConnection1 = CreateObject ("ADODB. Connection ")
Set ObjRecordSet1 = CreateObject ("ADODB. Recordset ")

Objconnection1.open _
"Provider = microsoft.ace.oledb.12.0;" & _
"Data Source = C:\inetpub\wwwroot\AccountList\Account.accdb"

Objrecordset1.open "INSERT into Accountlist (UserName, DisplayName, Officename, Accountstatus, Description, Lastlogontime, telephone, Business2, Ipphone, Title, Mailstore, Raskeynumber,webmailcheck, Mailboxquota) "& _
"VALUES ('" & Strid & "', '" & Strdisplayname & "', '" & Stroffice & "', '" & Straccountstate &A mp "', '" & Strdes & "', '" & Strllt & "', '" & Strtel & "', '" & Strbus & "', '" & Strip Hone & "', '" & Strtitle & "', '" & Strmstore1 & "', '" & Strkeynum & "', '" & Strwebmail & "', '" & Strquotamailbox & "')", _
ObjConnection1, adOpenStatic, adLockOptimistic

Objrecordset1.close
Objconnection1.close

Set ObjConnection1 = Nothing
Set ObjRecordSet1 = Nothing

End if

Tempvalue = Null

Err.Clear

End Sub

This article is from "Eric's Mind Journey" blog, declined reprint!

[Actual combat two]vbs script export user information to Access database