Abbadona
asked on
ASP/VBScript, iterate through folder, subfolders, and all files: halfway there
HI! I have a script that I would like to use to iterate through a collection of folders, subfolders, and all files and put these in a dictionary object for random display... Well, it's all working except for the the subfolders part which has given me a recursion headache. I think I might need a sub that refs itself, but I keep missing the syntax.
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
Option Explicit
Function RandomContent(ContentFolde
'Declare variables
Dim CompleteContentFolderPath
Dim FileSystemObject
Dim ContentFolder
Dim Files
Dim i
Dim ContentFiles
Dim File
Dim FileName
Dim FileExtension
Dim RandomNumber
'Find the complete path to image folder by using Server.MapPath
CompleteContentFolderPath = Server.MapPath(ContentFold
'Create an instance of the FileSystemObject which allows ASP to
'access the file system
Set FileSystemObject = Server.CreateObject("Scrip
'Check that the folder containing the images exists
If Not FileSystemObject.FolderExi
RandomContent = "Error 0: Cannot find requested folder"
Set FileSystemObject = nothing
Exit Function
End If
'Get the content folder
Set ContentFolder = FileSystemObject.GetFolder
'Get a list of all the files within the folder
Set Files = ContentFolder.Files
'Use a dictionary object to temporarily store the file names
i = 1
Set ContentFiles = Server.CreateObject("Scrip
'Loop through the list of files within the folder.
'If the file has a file extension that is in the list of
'file types specified in the ContentFileTypes function parameter,
'then add the file name to the ContentFiles dictionary object
For Each File in Files
FileName = File.Name
FileExtension = Right(FileName, Len(FileName) - (InStrRev(FileName, ".")))
If InStr(1,ContentFileTypes,F
ContentFiles.Add i, FileName
i = i + 1
End If
Next
'Destroy objects that are no longer required
Set ContentFolder = nothing
Set Files = nothing
Set FileSystemObject = nothing
'Initialise the random number generator
Randomize
'Check that file(s) have been found
If ContentFiles.Count = 0 Then
RandomContent = "Error 1: Requested folder does not contain any files of the specified type."
Exit Function
End If
'Generate random number between 1 and the number of files
RandomNumber = Int((ContentFiles.Count) * Rnd + 1)
'return link to random file
RandomContent = ContentFolderPath & ContentFiles.Item(RandomNu
Set ContentFiles = nothing
End Function
%>
<%'Response.Write RandomContent("/path/to/co
This is part of a larger application, and I just want to add recursion. Also, I wonder if it might be possible to have a method that would select files sequentially from the dictionary. Maybe I can do extra credit for that. This is my first question and I'm not quite sure how all this works yet. Thanks! --A
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
Option Explicit
Function RandomContent(ContentFolde
'Declare variables
Dim CompleteContentFolderPath
Dim FileSystemObject
Dim ContentFolder
Dim Files
Dim i
Dim ContentFiles
Dim File
Dim FileName
Dim FileExtension
Dim RandomNumber
'Find the complete path to image folder by using Server.MapPath
CompleteContentFolderPath = Server.MapPath(ContentFold
'Create an instance of the FileSystemObject which allows ASP to
'access the file system
Set FileSystemObject = Server.CreateObject("Scrip
'Check that the folder containing the images exists
If Not FileSystemObject.FolderExi
RandomContent = "Error 0: Cannot find requested folder"
Set FileSystemObject = nothing
Exit Function
End If
'Get the content folder
Set ContentFolder = FileSystemObject.GetFolder
'Get a list of all the files within the folder
Set Files = ContentFolder.Files
'Use a dictionary object to temporarily store the file names
i = 1
Set ContentFiles = Server.CreateObject("Scrip
'Loop through the list of files within the folder.
'If the file has a file extension that is in the list of
'file types specified in the ContentFileTypes function parameter,
'then add the file name to the ContentFiles dictionary object
For Each File in Files
FileName = File.Name
FileExtension = Right(FileName, Len(FileName) - (InStrRev(FileName, ".")))
If InStr(1,ContentFileTypes,F
ContentFiles.Add i, FileName
i = i + 1
End If
Next
'Destroy objects that are no longer required
Set ContentFolder = nothing
Set Files = nothing
Set FileSystemObject = nothing
'Initialise the random number generator
Randomize
'Check that file(s) have been found
If ContentFiles.Count = 0 Then
RandomContent = "Error 1: Requested folder does not contain any files of the specified type."
Exit Function
End If
'Generate random number between 1 and the number of files
RandomNumber = Int((ContentFiles.Count) * Rnd + 1)
'return link to random file
RandomContent = ContentFolderPath & ContentFiles.Item(RandomNu
Set ContentFiles = nothing
End Function
%>
<%'Response.Write RandomContent("/path/to/co
This is part of a larger application, and I just want to add recursion. Also, I wonder if it might be possible to have a method that would select files sequentially from the dictionary. Maybe I can do extra credit for that. This is my first question and I'm not quite sure how all this works yet. Thanks! --A
ASKER
Hi Neal, Thank you for your reply! I do have several similar examples to work from, but am having more specific trouble with syntax. So the above code works on its own (change the path and uncomment last line), and when included in the broader application. I am trying to combine an example like yours with the existing Scripting Dictionary stuff. Trying the following just now, for example, yields a "syntax error" with the carat indicating the first "Sub" as a culprit. I am missing something conceptually about the subroutine, and this is leading me to errors in implementing it.
Sub Recurse(ContentFolder, ContentFolderPath, i)
Dim ContentSubFolder
For Each ContentSubFolder in ContentFolder.SubFolders
For Each File in Files
FileName = File.Name
FileExtension = Right(FileName, Len(FileName) - (InStrRev(FileName, ".")))
If InStr(1,ContentFileTypes,F
ContentFiles.Add i, FileName
i = i + 1
End If
Next
Next
End Sub
It could be something very basic that I am overlooking, or perhaps something obscure. From my perspective, all I know is that I haven't been able to add the Sub in such a way that it doesn't break the script.
I will keep at it and post back if I solve it, but I have been reading and trying different stuff for two hours yesterday and one today so far without hitting the answer yet. So I relented and joined Experts! :)
Sub Recurse(ContentFolder, ContentFolderPath, i)
Dim ContentSubFolder
For Each ContentSubFolder in ContentFolder.SubFolders
For Each File in Files
FileName = File.Name
FileExtension = Right(FileName, Len(FileName) - (InStrRev(FileName, ".")))
If InStr(1,ContentFileTypes,F
ContentFiles.Add i, FileName
i = i + 1
End If
Next
Next
End Sub
It could be something very basic that I am overlooking, or perhaps something obscure. From my perspective, all I know is that I haven't been able to add the Sub in such a way that it doesn't break the script.
I will keep at it and post back if I solve it, but I have been reading and trying different stuff for two hours yesterday and one today so far without hitting the answer yet. So I relented and joined Experts! :)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
That's perfect, Neal, plus I will do a file compare to see where I was getting it wrong. Usually I am guided by error messages, but sometimes they aren't so meaningful. Thanks!
The big difference is that I moved the Recurse out to a subroutine as you had already suggested. I also moved the Dictionary obejct out of the function so that it would be available to the subroutine.
Neal.
Neal.
ASKER
Hi, Thanks it worked great on its own, but I may have jumped the gun. I put it above some code from XMLDOM that I am using to generate dynamic XML from the filesystem. I still get that same syntax error on the Sub I saw before, so it may be something else I'm doing that interferes, but I can't think of what. I'd rather not post the whole thing, but I wonder whether there might be a way to convey the source to you if you'd be kind enough to have a look. It's not too complex, but it works with a proprietary component that has a standalone solution for what I'm serving live, and I don't want to ding their sales because they have a cool product. Or I can formulate a new expert question. I'm not sure how that works yet. Thanks, --A
ASKER
It comes out later on as
Object required: 'ContentFiles'...
Object required: 'ContentFiles'...
The rules of the forum prevent me from taking the off-line so to speak. However you can post a link to your code here and remove it the code from the spot linked to later. You may reopen the question if you wish by submitting a request to community support. https://www.experts-exchange.com/Community_Support/ Just provide a link to this page in your post.
I will be happy to continue working on this regardless, but with the question closed, it is unlikely that too many others will join in.
I'm happy to proceed however you wish
Neal.
I will be happy to continue working on this regardless, but with the question closed, it is unlikely that too many others will join in.
I'm happy to proceed however you wish
Neal.
Make sure you are not closing the ContentFiles object in your function.
ASKER
That's all right. I have added it in a zip here with a note. There is one file that begins "almost... " That's the current one with your addition, and I've indented it for legibility. The other file is the current one that doesn't recurse. The note includes a URL to the example on my personal site.
http://tinyurl.com/jv95u
Thanks!
PS did you get 300? I raised the count before accepting... I had better go read the rules. :)
http://tinyurl.com/jv95u
Thanks!
PS did you get 300? I raised the count before accepting... I had better go read the rules. :)
ASKER
It was in the set to nothing function, then I moved it just after the function, tried it at the end of the file... I even tried not destroying it at all. My server will thank me later. :)
ASKER
It is now "This Key is already associated with an element of this collection." I think that's getting better. I am reading up on that now to narrow it down...
The reason you are getting this error is that the RandomContent function is being called from a loop.
Each time it is called it starts variable i off at 1. it then uses i as the key for the dictionary item.
In the Recurse function, try setting i to ContentFiles.Count + 1 like this:
--------------------------
Sub Recurse(ContentFolder, ContentFolderPath, ContentFileTypes)
Dim ContentSubFolder, File, FileName, FileExtension,i
i = ContentFiles.Count + 1
For Each ContentSubFolder in ContentFolder.SubFolders
For Each File in ContentSubFolder.Files
FileName = File.Name
FileExtension = Right(FileName, Len(FileName) - (InStrRev(FileName, ".")))
If InStr(1,ContentFileTypes,F
ContentFiles.Add i, FileName
i = i + 1
End If
Next
Next
End Sub
--------------------------
and change the line that calls Recurse to remove the value for i:
--------------------------
Recurse ContentFolder,"",ContentFi
--------------------------
Neal.
Each time it is called it starts variable i off at 1. it then uses i as the key for the dictionary item.
In the Recurse function, try setting i to ContentFiles.Count + 1 like this:
--------------------------
Sub Recurse(ContentFolder, ContentFolderPath, ContentFileTypes)
Dim ContentSubFolder, File, FileName, FileExtension,i
i = ContentFiles.Count + 1
For Each ContentSubFolder in ContentFolder.SubFolders
For Each File in ContentSubFolder.Files
FileName = File.Name
FileExtension = Right(FileName, Len(FileName) - (InStrRev(FileName, ".")))
If InStr(1,ContentFileTypes,F
ContentFiles.Add i, FileName
i = i + 1
End If
Next
Next
End Sub
--------------------------
and change the line that calls Recurse to remove the value for i:
--------------------------
Recurse ContentFolder,"",ContentFi
--------------------------
Neal.
By the way, yes I did receive the full points you posted.
Thanks.
Neal.
Thanks.
Neal.
ASKER
Wonderful, it really works this time. :) Thank you so much. For anyone that uses the above, I made a small change to hit the right path:
ContentFiles.Add i, ContentSubFolder.Name & "/" & FileName
I will probably do that outside the Recurse function later so I have a more granular entry in the dictionary--I might want to do other stuff with it. Thanks very much for your help, Neal! --A
ContentFiles.Add i, ContentSubFolder.Name & "/" & FileName
I will probably do that outside the Recurse function later so I have a more granular entry in the dictionary--I might want to do other stuff with it. Thanks very much for your help, Neal! --A
No Problem, glad I could help.
--------------------------
vRootPath = session("FolderName") ' Put in the root folder you want to add here'
dim fs
set fs=Server.CreateObject("Sc
' Get Folders from drive
' --------------------------
vPath = vRootPath
if fs.FolderExists(vPath) then
Set fld = fs.GetFolder(vPath)
RecursiveFolderList fld, "", 2
else
response.write("Folder " & vPath & " does not exist.")
end if
Set fld = Nothing
Set fs = Nothing
Sub RecursiveFolderList(fld, PathName, x)
For Each subfld in fld.SubFolders
response.Write "<script type='text/javascript'>tre
RecursiveFolderList subfld,subfld , x+1
Next
End Sub
--------------------------
Note that the response.write line in the Subroutine is simply what I use when creating my TreeView, you would substitute whatever you wanted there.
Hope this helps,
Neal.