Windows Vista Forums
Vista Forums Home Join Vista Forums Windows 7 Forum Vista Tutorials Tags
Welcome to Windows Vista Forums. Our forum is dedicated to helping you find solutions with any problems, errors or issues you are experiencing with Windows Vista. The Vista forum also covers news and updates and has an extensive Windows Vista tutorial section that covers a wide range of tips and tricks.

Go Back   Vista Forums > Misc Newsgroups > VB Script
Reload this Page Help with a HTA
Join Now FAQ Search Today's Posts Mark Forums Read

Vista - Help with a HTA

Reply
 
Old 07-30-2009   #1 (permalink)
OldDog


 
 

Help with a HTA
Hi,

I am trying to build an HTA that will Query an AD Group for it's
Common Name.

I have a list of groups and I would like the HTA to display the list
and then allow me to pick one and then run my query on this list. If I
just put one group name in the Body, it works.

So far I have this:

<html>
<head>
<title>Get ADSPath and OU From AD</title>
<HTA:APPLICATION
ID="objADSPath-OU"
APPLICATIONNAME="Get ADSPath and OU"
SCROLL="off"
SINGLEINSTANCE="yes"
Quote:

>
</head>
<script language="VBScript">
Sub Window_Onload
self.Focus()
self.ResizeTo 900,600
End Sub

Sub RunScript
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
DNC = GetObject("LDAP://RootDSE").Get("defaultNamingContext")

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

If Trim(AD_Obj.Value) = "" Then
ADobj = "Administrator" : AD_Obj.Value = "Administrator"
Else
ADobj=Trim(AD_Obj.Value)
End If

objCommand.CommandText = "SELECT Adspath FROM 'LDAP://" & DNC & "'" &
_
" WHERE name='" & ADobj & "'" & " OR sAMAccountName='" & ADobj &
"'"

Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

If Err <> 0 Then
If Err.Number = 3021 Then
TxtADSPath.Value = Trim(AD_Obj.Value) & " Not Found!!!"
Else
TxtADSPath.Value = Err.Number & " " & Err.Description
End If
txtou.Value = ""
Err.Clear
Exit Sub
End If

arrAD = Split(objRecordSet.Fields("AdsPath").Value, ",")

For i = 0 to Ubound(arrAD)
If InStr(arrAD(i), "OU=") Or InStr(arrAD(i), "LDAP://OU=") Then
iLength = Len(arrAD(i))
leading = iif(InStr(arrAD(i),"LDAP://OU="),10,3)
OULength = iLength - leading
OU = Right(arrAD(i), OULength)
Exit For
End If
Next
txtou.Value = OU

TxtADSPath.Value = objRecordSet.Fields("Adspath").Value
objRecordSet.MoveNext
Msgbox "Done"
End Sub

Function iif(cond,t,f)
If cond Then
iif = t
Else
iif = f
End If
End Function
</script>

<BODY>
AD Object
<input type="text" name="AD_Obj" size="30" value="dl zl crdm in house
marketing"><br>
<!--
AD Object
<input type="text" name="AD_Obj" size="30" value="dl zl crdm
marketing"><br> <-- More Groups
AD Object
<input type="text" name="AD_Obj" size="30" value="dl zl crdm marketing
support"><br> <-- More Groups

-->
<input type="button" value="Get AdsPath & OU" name="GetOUb"
onclick="RunScript"><p>

AdsPath
<input type="text" name="TxtADSPath" size="145" readonly><p>
OU
<input type="text" name="txtOU" size="20" readonly><p>
<input type="BUTTON" name="button1" value="Exit" onclick=self.close>
</BODY>
</html>
My System SpecsSystem Spec
Old 07-30-2009   #2 (permalink)
MattW


 
 

Re: Help with a HTA
I had a similar issue earlier this week with user names listed in a
txt file, and Richard Mueller was able to provide me with the
following code to help, it should be interchangeable if you change the
Object Category and Class from User to Group.

Quote:
You must read the file of names in a loop, then for each name run the
ADO
query to find the user with the Common Name read from the file. This
involves nested loops. Also, you must concatenate the value of the
variable
strLine into the query string. Otherwise, you are searching for the
user
with Common Name "strLine". I have not tested, but I think the code
below
should work. Watch out for line wrapping:
==========
Option Explicit

Dim strExcelPath, strFilePath, adoConnection, adoCommand, objRootDSE,
strDNSDomain
Dim strFilter, strQuery, adoRecordset, strDN, objExcel, objSheet, k,
objUser, objFSO
Dim objFile, strLine, intIndex


' Check for required arguments.
Const ForReading = 1


' Specify the text file of user names.
strFilePath = "c:\MyFolder\UserList.txt"


' Open the file for read access.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFilePath, ForReading)


' Spreadsheet file to be created.
strExcelPath = "c:\myfolder\selectivelist.xls"


' Bind to Excel object.
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add


' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Domain User"
objSheet.Cells(1, 1).Value = "User Distinguished Name"


' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection


' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")


adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False


k = 2
' Read the text file of names.
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
' Skip blank lines.
If (strLine <> "") Then
strFilter = "(&(objectCategory=person)(objectClass=user)(cn="
&
strLine & "))"
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
& ";distinguishedName;subtree"
adoCommand.CommandText = strQuery


' Enumerate all users. Write each user's Distinguished Name to
the
' spreadsheet.
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
' Escape any forward slash characters, "/", with the
backslash
' escape character. All other characters that should be
escaped
are.
strDN = Replace(strDN, "/", "\/")
objSheet.Cells(k, 1).Value = strDN
k = k + 1
adoRecordset.MoveNext
Loop
adoRecordset.Close
End If
Loop


' Format the spreadsheet.
objSheet.Range("A1:A1").Font.Bold = True
objSheet.Select
objExcel.Columns(1).ColumnWidth = 80


' Save the spreadsheet.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close


' Quit Excel.
objExcel.Application.Quit


' Clean up.
adoConnection.Close
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Set objUser = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing
Set objRootDSE = Nothing
Set adoRecordset = Nothing
Set objSheet = Nothing
Set objExcel = Nothing


Wscript.Echo "Done"
My System SpecsSystem Spec
Old 07-30-2009   #3 (permalink)
OldDog


 
 

Re: Help with a HTA
On Jul 30, 2:12*pm, MattW <winber...@xxxxxx> wrote:
Quote:

> I had a similar issue earlier this week with user names listed in a
> txt file, and Richard Mueller was able to provide me with the
> following code to help, it should be interchangeable if you change the
> Object Category and Class from User to Group.
>
>
Quote:
> You must read the file of names in a loop, then for each name run the
> ADO
> query to find the user with the Common Name read from the file. This
> involves nested loops. Also, you must concatenate the value of the
> variable
> strLine into the query string. Otherwise, you are searching for the
> user
> with Common Name "strLine". I have not tested, but I think the code
> below
> should work. Watch out for line wrapping:
> ==========
> Option Explicit
>
> Dim strExcelPath, strFilePath, adoConnection, adoCommand, objRootDSE,
> strDNSDomain
> Dim strFilter, strQuery, adoRecordset, strDN, objExcel, objSheet, k,
> objUser, objFSO
> Dim objFile, strLine, intIndex
>
> ' Check for required arguments.
> Const ForReading = 1
>
> ' Specify the text file of user names.
> strFilePath = "c:\MyFolder\UserList.txt"
>
> ' Open the file for read access.
> Set objFSO = CreateObject("Scripting.FileSystemObject")
> Set objFile = objFSO.OpenTextFile(strFilePath, ForReading)
>
> ' Spreadsheet file to be created.
> strExcelPath = "c:\myfolder\selectivelist.xls"
>
> ' Bind to Excel object.
> Set objExcel = CreateObject("Excel.Application")
> objExcel.Workbooks.Add
>
> ' Bind to worksheet.
> Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
> objSheet.Name = "Domain User"
> objSheet.Cells(1, 1).Value = "User Distinguished Name"
>
> ' Use ADO to search the domain for all users.
> Set adoConnection = CreateObject("ADODB.Connection")
> Set adoCommand = CreateObject("ADODB.Command")
> adoConnection.Provider = "ADsDSOOBject"
> adoConnection.Open "Active Directory Provider"
> Set adoCommand.ActiveConnection = adoConnection
>
> ' Determine the DNS domain from the RootDSE object.
> Set objRootDSE = GetObject("LDAP://RootDSE")
> strDNSDomain = objRootDSE.Get("defaultNamingContext")
>
> adoCommand.Properties("Page Size") = 100
> adoCommand.Properties("Timeout") = 30
> adoCommand.Properties("Cache Results") = False
>
> k = 2
> ' Read the text file of names.
> Do Until objFile.AtEndOfStream
> * * strLine = Trim(objFile.ReadLine)
> * * ' Skip blank lines.
> * * If (strLine <> "") Then
> * * * * strFilter = "(&(objectCategory=person)(objectClass=user)(cn="
> &
> strLine & "))"
> * * * * strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter_
> * * * * * * & ";distinguishedName;subtree"
> * * * * adoCommand.CommandText = strQuery
>
> * * * * ' Enumerate all users. Write each user's Distinguished Name to
> the
> * * * * ' spreadsheet.
> * * * * Set adoRecordset = adoCommand.Execute
> * * * * Do Until adoRecordset.EOF
> * * * * * * strDN = adoRecordset.Fields("distinguishedName").Value
> * * * * * * ' Escape any forward slash characters, "/", with the
> backslash
> * * * * * * ' escape character. All other characters that should be
> escaped
> are.
> * * * * * * strDN = Replace(strDN, "/", "\/")
> * * * * * * objSheet.Cells(k, 1).Value = strDN
> * * * * * * k = k + 1
> * * * * * * adoRecordset.MoveNext
> * * * * Loop
> * * * * adoRecordset.Close
> * * End If
> Loop
>
> ' Format the spreadsheet.
> objSheet.Range("A1:A1").Font.Bold = True
> objSheet.Select
> objExcel.Columns(1).ColumnWidth = 80
>
> ' Save the spreadsheet.
> objExcel.ActiveWorkbook.SaveAs strExcelPath
> objExcel.ActiveWorkbook.Close
>
> ' Quit Excel.
> objExcel.Application.Quit
>
> ' Clean up.
> adoConnection.Close
> objFile.Close
> Set objFile = Nothing
> Set objFSO = Nothing
> Set objUser = Nothing
> Set adoConnection = Nothing
> Set adoCommand = Nothing
> Set objRootDSE = Nothing
> Set adoRecordset = Nothing
> Set objSheet = Nothing
> Set objExcel = Nothing
>
> Wscript.Echo "Done"
>
Thank you, I did figure the HTA part out.

I found this on the Microsoft site:

'<------ HTA------>

<SCRIPT LANGUAGE="VBScript">

Sub RunScript

If ComputerOption(0).Checked Then
strComputer = ComputerOption(0).Value
End If
If ComputerOption(1).Checked Then
strComputer = ComputerOption(1).Value
End If
If ComputerOption(2).Checked Then
strComputer = ComputerOption(2).Value
End If
If ComputerOption(3).Checked Then
strComputer = ComputerOption(3).Value
End If

If strComputer = "" Then
Exit Sub
End If

Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_OperatingSystem")
For Each objItem in colItems
Msgbox objItem.Caption
Next

End Sub

Sub CancelScript
Self.Close()
End Sub

</SCRIPT>

<BODY>
<input type="radio" name="ComputerOption" value="atl-ws-01">CRESCJ1-
L8<BR>
<input type="radio" name="ComputerOption" value="atl-ws-02">ELIASD1-
D3<BR>
<input type="radio" name="ComputerOption" value="atl-ws-03">FANNIK1-
D2<BR>
<input type="radio" name="ComputerOption" value="atl-ws-04">FELKIM1-
D10<P>

<input id=runbutton class="button" type="button" value="Run Script"
name="ok_button"
onClick="RunScript">
&nbsp;&nbsp;&nbsp;
<input id=runbutton class="button" type="button" value="Cancel"
name="cancel_button"
onClick="CancelScript">

</BODY>


<----- End HTA------>
My System SpecsSystem Spec
Reply

« AutoLogin XP | I need to MAP a drive to the local computer »
Thread Tools



Vista Forums is an independent web site and has not been authorized,
sponsored, or otherwise approved by Microsoft Corporation.
"Windows Vista", the Start Orb, and related materials are trademarks of Microsoft Corp.
© Designer Media Ltd
Contact Us - Windows Vista Forums - Archive - Privacy - Legal - Top

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46