Hi, I'm kind of new to VBS. I had a script that worked in XP that would list a certain type of files in a folder and its subdirectories. But I can't get it to work in Win7, I get "Invalid roor in Registry Key", code 80070005. Here is this script (I have other similar that doesnt work either):




' To Install or Un-install, double click this file.

Option Explicit
Dim FSO, WS, IMG, Args, Folder
Dim FilmHTML
Dim Title
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WS = CreateObject("Wscript.Shell")
Set Args = WScript.Arguments
Title = "List all Films>"

'If script called directly, check setup & uninstall.
If Args.Count = 0 Then
Call Setup
End If

'Disable multiple drag and drop
If Args.Count > 1 Then
Call Cleanup
End If

Set FilmHTML = FSO.CreateTextFile(FSO.GetFolder(Args(0)) & ".html", True)
FilmHTML.WriteLine "<HTML>"
FilmHTML.WriteLine "<HEAD>"
FilmHTML.WriteLine "<style type=""text/css"">"
FilmHTML.WriteLine "h2 {margin-bottom:0 ;padding:0;}"
FilmHTML.WriteLine "</style>"
FilmHTML.WriteLine "</HEAD>"

FilmHTML.WriteLine "<BODY STYLE=""color: yellow; background-color: " & _
"DARKBLUE; font-size: 12pt"">"

set Folder = FSO.GetFolder(Args(0))

FilmHTML.WriteLine("<H1><U>" & Folder.Name & "</u></H1>")

Call EachDir(Folder)

Call FlimList(Folder)

FilmHTML.WriteLine "</BODY>"
FilmHTML.WriteLine "</HTML>"
FilmHTML.Close

WS.Popup "Finished"

Sub FlimList(pCurrDir)
Dim SubName, SubFolders, subf, subnam

'Reference the Directory collection of the Film directory

set SubFolders = pCurrDir.SubFolders

For Each SubName in SubFolders
set subf = FSO.GetFolder(SubName)

subnam = subf.Name
FilmHTML.WriteLine ("<h2>" & subnam & "</h2>")
FilmHTML.WriteLine ("<ul TYPE=disc>")

Call EachDir(subf)

Call FlimList(SubName)

FilmHTML.WriteLine ("</ul>")

Next
End Sub

Sub EachDir(Folder)
Dim strFIL, Ext, Film
FilmHTML.WriteLine ("<FONT COLOR=WHITE><B>")

For Each strFIL in Folder.Files

Ext = LCase(fso.GetExtensionName(strFIL))

Select Case Ext
Case "avi", "mpg", "mpeg", "mp4"
Film = Left(strFIL.Name,Len(strFIL.Name)-Len(EXT)-1)
If InStr(Film, " @ ") = 0 Then
FilmHTML.WriteLine("<br>" & Film)
Else
FilmHTML.WriteLine ("<FONT COLOR=CYAN>")
FilmHTML.WriteLine("<br>" & Film)
FilmHTML.WriteLine ("</FONT>")
End If
End Select

Next

FilmHTML.WriteLine ("</FONT></B>")

End Sub

Sub Setup
'Write Reg Data if not existing or if path is invalid.
Dim p
On Error Resume Next
p = WS.RegRead("HKCR\Folder\shell\FilmList\command\")
p = Mid(p, 10, Len(p) - 15)
Err.Clear:On Error GoTo 0
If NOT FSO.FileExists(p) Then
If WS.Popup("Do you want to Install the Folder context menu to " & _
"List Films ?", , Title, 4 + 32 + 4096) <> 6 Then
Call Cleanup
End If
WS.Popup("Nu kommer 1")
WS.RegWrite "HKCR\Folder\shell\FilmList\","&List Films"
WS.Popup("Nu kommer 2")
WS.RegWrite "HKCR\Folder\shell\FilmList\command\", _
"WScript " & chr(34) & WScript.ScriptFullName & _
chr(34) & " " & chr(34) & "%1" & chr(34)
WS.Popup "Setup complete. Right click on any Folder in Windows " & vbcrlf & vbcrlf & _
"To Un-install, run this script again.", , Title, 64 + 4096
Else
If WS.Popup("Do you want to Un-install the Folder context menu to " & _
"List Films ?", , Title, 4 + 32 + 4096) <> 6 Then
Call Cleanup
End If
WS.RegDelete "HKCR\Folder\shell\FilmList\command\"
ws.RegDelete "HKCR\Folder\shell\FilmList\"
WS.Popup "Un-install complete.", , Title, 64 + 4096
End If
Call Cleanup
End Sub

Sub Cleanup
Set WS = Nothing
Set FSO = Nothing
Set Args = Nothing
Set Folder = Nothing

Set SubFolders = Nothing
Set SubName = Nothing
Set JPEGName = Nothing
Set NewJPG = Nothing
Set strFIL = Nothing
Set Ext = Nothing
Set newJPEGName = Nothing
WScript.Quit
End Sub