close excel file after reading reg key

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

close excel file after reading reg key

Logged in as: Guest

arrSession:exec spGetSession 2,2,48487

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> WSH & Client Side VBScript >> close excel file after reading reg key
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

close excel file after reading reg key - 6/19/2007 6:53:40 AM

ekrengel

Posts: 28
Score: 0
Joined: 5/11/2007
Status: offline

Does anyone know how to make this excel file close after it has opened and put the values inside? Right now I have to manually close excel, and then it continues the rest of the script...

rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,True)

Post #: 1

RE: close excel file after reading reg key - 6/19/2007 7:09:40 AM

LANlazy

Posts: 82
Score: 0
Joined: 4/11/2007
Status: offline

can you post the entire script?

(in reply to ekrengel)

Post #: 2

RE: close excel file after reading reg key - 6/19/2007 7:15:21 AM

ekrengel

Posts: 28
Score: 0
Joined: 5/11/2007
Status: offline

Ok...It's pretty long, but here it is:

Dim objGroup, objUser, objShell, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, oUser, fso
Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount, strFullName

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objShell = CreateObject("Wscript.Shell")
Set objNet = CreateObject("WScript.Network")
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
strRootDSE = objRootDSE.Get("defaultNamingContext")
strDomain = UCase(objNet.UserDomain)
strSearch = LCase(InputBox("Select the group you would like to use."))
ListGroups( strDomain )
intOpt = 1
sGroup = SelectBox("Select the Group", aOpt)
strFormat = "Excel"

Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
if sgroup <> "Aborted" then
if sgroup <> "Select the Group" then
if strFormat = "Excel" then
strFile = "temp.csv"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFile) Then
fso.DeleteFile(strFile)
End If
Set txtFile = fso.CreateTextFile(strFile)
i = 0
For Each oUser In oGroup.Members
i = i + 1
strGetUserName=""
strDN=""
strMail=""
strGetUserName= UCase(oUser.Name)
while strDN=""
CheckForUser()
Wend
GetUserAccount(strDN)
txtFile.write (strLogonName  & " , " & strDisplayDepartment & " , " & strMail & vbCrLf)
Next
txtFile.close
Set txtFile = nothing
Set fso = nothing
strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
If KeyExists(strKey) = True Then
strKeyValue = WshShell.RegRead(strKey)
rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,True)
else
rval = WshShell.Run("notepad.exe" & " " & strFile,1,True)
end if
else
For Each oUser In oGroup.Members
i = i + 1
strGetUserName=""
strDN=""
strMail=""
strGetUserName= UCase(oUser.Name)
while strDN=""
CheckForUser()
Wend
GetUserAccount(strDN)
strBCC = strBCC & strMail &"; "
Next
Set oMailApp = CreateObject("Outlook.Application")
Set olMailItm = oMailApp.CreateItem(olMailItem)
olMailItm.BCC = strBCC
olMailItm.Display
end if
end if
end if

Sub CheckForUser()
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = ("ADsDSOObject")
objConnection.Open
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
"<LDAP://" & strRootDSE & ">;(&(objectCategory=User)" & _
"(samAccountName=" & strGetUserName & "));distinguishedName,cn,sAMAccountName,name;subtree"
Set objRecordSet = objCommand.Execute
strDN = objRecordset.Fields("distinguishedName")
Set objectRecordSet = Nothing
objConnection.close
Set objConnection = Nothing

End Sub

Sub GetUserAccount(strDN)
On Error Resume Next
If InStr(1,strDN,"/") Then strDN=Replace(strDN,"/","\/")
Set objUser = GetObject("LDAP://" & strDN & "")
Set objAdS = GetObject("LDAP://" & strRootDSE & "")

With objUser
'.GetInfo
strMail = .Get("mail")
strLogonName = .Get("cn")
strUserMail = .Get("mail")
strDescription = .GetEx("description")
strDepartment = .GetEx("department")

strDisplayDepartment=""
For Each strValue in strDepartment
strDisplayDepartment = strDisplayDepartment & strValue
Next

For Each strValue in strDescription
strDisplayDescription = strDisplayDescription & strValue
Next

End With

End Sub

Sub ListGroups( strDomain )
Set objComputer = GetObject("WinNT://" & strDomain )
objComputer.Filter = Array( "Group" )
For Each objGroup In objComputer
if InStr(LCase(objGroup.Name),strSearch) then
ReDim Preserve aOpt(intOpt+ 1)
aOpt(intOpt) = objGroup.Name
intOpt = intOpt + 1
end if
Next
End Sub

Function SelectBox(sTitle, aOptions)
Dim oIE, s, item
set oIE = CreateObject("InternetExplorer.Application")
With oIE
.FullScreen = True
.ToolBar = False : .RegisterAsDropTarget = False
.StatusBar = False : .Navigate("about:blank")
Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
.width= 400 : .height=200
With .document
with .parentWindow.screen
oIE.left = (.availWidth - oIE.width ) \ 2
oIE.top = (.availheight - oIE.height) \ 2
End With
s = "<html><head><title>" & sTitle _
& "</title></head><script language=vbs>bWait=true<" & "/script>" _
& "<body bgColor=Silver><center>" _
   & "<b>" & sTitle & "<b><p>" _
& "<select id=entries size=1 style='width:325px'>" _
& " <option selected>" & sTitle & "</option>"
For each item in aOptions
s = s & " <option>" & item & "</option>"
Next
s = s & " </select><p>" _
& "<button id=but0 onclick='bWait=false'>OK</button>" _
& "</center></body></html>"
.open
.Write(s)
.close
Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
With .body
.scroll="no"
.style.borderStyle = "outset"
.style.borderWidth = "3px"
End With
.all.entries.focus
oIE.Visible = True
CreateObject("Wscript.Shell").AppActivate sTitle
On Error Resume Next
Do While .ParentWindow.bWait
WScript.Sleep 100
if oIE.Visible Then SelectBox = "Aborted"
if Err.Number <> 0 Then Exit Function
Loop
On Error Goto 0
With .ParentWindow.entries
SelectBox = .options(.selectedIndex).text
End With
End With
.Visible = False
End With
End Function

Function KeyExists(sKeyPath)
keyExists= false: if (sKeyPath="") then exit function
on error resume next
createobject("wscript.shell").regRead sKeyPath
select case err
case 0: keyExists= true
case &h80070002: dim sErrMsg
sErrMsg= replace(err.description, sKeyPath, "")
err.clear
createobject("wscript.shell").regRead "HKEY_ERROR\"
keyExists= not (sErrMsg=replace(err.description, "HKEY_ERROR\", ""))
case else: keyExists= false
end select
on error goto 0
End function

'---Excel Formatting--------------------------

Set objExcel = CreateObject("Excel.Application")
   objExcel.Application.DisplayAlerts = False
   objExcel.Visible = False

Set objWorkbook = objExcel.Workbooks.Open("temp.csv")

sRow = "1"
   objExcel.Worksheets(1).Rows(sRow).Insert xlDown
   objExcel.Worksheets(1).Rows(sRow).Insert xlDown
   objExcel.Worksheets(1).Rows(sRow).Insert xlDown
   
   objExcel.Cells(1,1).Value = "Department"
   objExcel.Cells(1,1).Font.Bold = True
   objExcel.Cells(1,1).Font.Size = 11
   objExcel.Cells(1,1).Interior.ColorIndex = 11 
   objExcel.Cells(1,1).Interior.Pattern = 1 'xlSolid 
   objExcel.Cells(1,1).Font.ColorIndex = 2
   objExcel.Cells(1,1).HorizontalAlignment = 3 'xlCenter
   objExcel.Cells(1,1).Borders.LineStyle = 1 '= xlSolid

objExcel.Range("A1","D1").MergeCells = 1

objExcel.Cells(3,1).Value = "Lastname"
   objExcel.Cells(3,1).Font.Bold = True

objExcel.Cells(3,2).Value = "Firstname"
   objExcel.Cells(3,2).Font.Bold = True

objExcel.Cells(3,3).Value = "Department"
   objExcel.Cells(3,3).Font.Bold = True

objExcel.Cells(3,4).Value = "Email Address"
   objExcel.Cells(3,4).Font.Bold = True

objExcel.Columns("A:AH").EntireColumn.AutoFit
   
   objExcel.ActiveWorkbook.SaveAs("temp.xls"), 43
   objExcel.Quit

Set objShell = CreateObject("Wscript.Shell")
   objShell.Run("%comspec% /c DEL temp.csv"), 0, True
       Set objShell = Nothing
'------------------------------------------------------------------------------------------------------------------

WScript.Quit

(in reply to LANlazy)