[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2788
  • Last Modified:

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(ContentFolderPath, ContentFileTypes, ContentDescriptor)
'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(ContentFolderPath)
'Create an instance of the FileSystemObject which allows ASP to
'access the file system
Set FileSystemObject = Server.CreateObject("Scripting.FileSystemObject")
'Check that the folder containing the images exists
If Not FileSystemObject.FolderExists(CompleteContentFolderPath) Then
RandomContent = "Error 0: Cannot find requested folder"
Set FileSystemObject = nothing
Exit Function
End If
'Get the content folder
Set ContentFolder = FileSystemObject.GetFolder(CompleteContentFolderPath)
'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("Scripting.Dictionary")
'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,FileExtension,vbTextCompare) > 0 then
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(RandomNumber)
Set ContentFiles = nothing
End Function
%>
<%'Response.Write RandomContent("/path/to/content/", "mp3", "random")%>

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
0
Abbadona
Asked:
Abbadona
  • 8
  • 8
1 Solution
 
nschaferCommented:
I have a file manager page I created that uses a recursion routine.  I'm actually putting the folders in a treeview, but perhaps what I have here will help you.

----------------------------------------------
vRootPath = session("FolderName") ' Put in the root folder you want to add here'
dim fs
set fs=Server.CreateObject("Scripting.FileSystemObject")
' 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'>treeAdd(" & x & ",'" & subfld.Name & "','" & replace(subfld.shortpath,"\","\\") & "');</script>" & vbCrLf
    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.
0
 
AbbadonaAuthor Commented:
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,FileExtension,vbTextCompare) > 0 then
                        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! :)
0
 
nschaferCommented:
Welcome to Experts Exchange.  

I think the following re-write of your original code will do what you are asking.  

Hope this helps,

Neal.

-----------------------------------------------------------------------------------------------------------
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
Option Explicit
dim ContentFiles
'Use a dictionary object to temporarily store the file names
Set ContentFiles = Server.CreateObject("Scripting.Dictionary")

Function RandomContent(ContentFolderPath, ContentFileTypes, ContentDescriptor)
  'Declare variables
  Dim CompleteContentFolderPath
  Dim FileSystemObject
  Dim ContentFolder
  Dim Files
  Dim RandomNumber
  'Find the complete path to image folder by using Server.MapPath
  CompleteContentFolderPath = Server.MapPath(ContentFolderPath)
  'Create an instance of the FileSystemObject which allows ASP to
  'access the file system
  Set FileSystemObject = Server.CreateObject("Scripting.FileSystemObject")
  'Check that the folder containing the images exists
  If Not FileSystemObject.FolderExists(CompleteContentFolderPath) Then
    RandomContent = "Error 0: Cannot find requested folder"
    Set FileSystemObject = nothing
    Exit Function
  End If
  'Get the content folder
  Set ContentFolder = FileSystemObject.GetFolder(CompleteContentFolderPath)
  Recurse ContentFolder,"",1, ContentFileTypes
  'Destroy objects that are no longer required
  Set ContentFolder = 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(RandomNumber)
  Set ContentFiles = nothing
End Function

Sub Recurse(ContentFolder, ContentFolderPath, i, ContentFileTypes)
  Dim ContentSubFolder, File, FileName, FileExtension
  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,FileExtension,vbTextCompare) > 0 then
        ContentFiles.Add i, FileName
        i = i + 1
      End If
    Next
  Next
End Sub

%>

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" >
<head>
    <title>Untitled Page</title>
</head>
<body>
<%
Response.Write RandomContent("/", "mp3", "random")
%>

</body>
</html>
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
AbbadonaAuthor Commented:
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!
0
 
nschaferCommented:
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.
0
 
AbbadonaAuthor Commented:
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
0
 
AbbadonaAuthor Commented:
It comes out later on as

Object required: 'ContentFiles'...
0
 
nschaferCommented:
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. http://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.
0
 
nschaferCommented:
Make sure you are not closing the ContentFiles object in your function.
0
 
AbbadonaAuthor Commented:
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. :)
0
 
AbbadonaAuthor Commented:
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. :)
0
 
AbbadonaAuthor Commented:
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...
0
 
nschaferCommented:
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,FileExtension,vbTextCompare) > 0 then
        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,"",ContentFileTypes
-----------------------------------------------------------------------

Neal.
0
 
nschaferCommented:
By the way, yes I did receive the full points you posted.  

Thanks.

Neal.
0
 
AbbadonaAuthor Commented:
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
0
 
nschaferCommented:
No Problem,  glad I could help.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 8
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now