Pass a String as the Path for GetFolder 3

[DougInCanada]

Hello All,

Here's the deal...

I have a text file with a list of folder names.

ie:
C:\folder1
C:\folder2
C:\folder3

I would like to reference each folder in the textfile, line by line, insert the folder name into the GetFolder(FolderNameHere), allowing me to perform an action with each line in a loop...

My script is generating a syntax error (Line xx Char 1) when I try to complete the following:

dim strDouble, strString, FSO, objdirectory, TheFiles

Set FSO = CreateObject("Scripting.FileSystemObject")
strDouble = Chr(34)

Set txtNames = FSO.OpenTextFile("C:\FolderNames.txt", 1)
Do Until txtNames.AtEndOfStream
The Script dies on the next line...
[COLOR=red yellow]Set objDirectory = FSO.GetFolder(strDouble & txtNames.readline & strDouble)[/color]
The rest of the code hasn't tested out yet, but this is the idea...
Set TheFiles = objDirectory.Files
....
Loop

It seems like I've tried everything to get FSO.GetFolder to read the FolderPath from a string variable, but it only seems to read an actual string, like the Set txtNames line above. I've even tried using another string, strFolderName, create this variable:
strFolderName = strDouble & txtNames.Readline & strDouble
then insert just the string strFolderName in place of the required Path string, but that doesn't work either...

Is this normal? Should I be using another method?

This is a show stopper for me....help?

 

[tsuji]

Hello DougInCanada,

txtNames.readline returns a string already. So no reason to need strDouble.

Set objDirectory = FSO.GetFolder(txtNames.readline)

regards - tsuji

 

[tsuji]

If this can help view the thing from another angle rather than make it more confusing.

Set objDirectory = FSO.GetFolder(eval(chr(34) & txtNames.readline & chr(34)))

The two lines result the same folder.

- tsuji

 

[DougInCanada]

Thanks, Sensei tsuji!

The first option worked fine....I'm used to doing most of my programming in VB, so I get syntactically challenged sometimes....

However, I'm having trouble calling a Sub in the remainder of the script. Perhaps if I post the script and provide a brief explanation of what I'm trying to accomplish, you'll be able to point me in the right direction.

The script will be user-invoked. It will parse the user's C drive for any folder names in which the user may have saved data (ie: *.doc, *.xls, *.mdb, *.pst, etc.) but exclude any folders in which the user (who is a simple user) is denied access. It then searches each folder for files with the explicit extensions and returns the complete path and filename for each of these files.

Here's what I have so far....

dim FSO, WSH, ObjDirectory, objFile, TheFiles, objFolders, txtList, objSubFolders, txtNames

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set objFolders = FSO.Drives("C").RootFolder.SubFolders

If FSO.FileExists ("C:\FolderNames.txt") then
FSO.DeleteFile "C:\FolderNames.txt"
End If
'10
Set txtNames = FSO.CreateTextFile ("C:\FolderNames.txt")

If FSO.FileExists ("C:\List1.txt") then
FSO.DeleteFile "C:\List1.txt"
End If

Set txtList1 = FSO.CreateTextFile ("C:\List1.txt")
txtList1.Close

For Each objSubFolders in objFolders
If objSubFolders.Name <> "WINNT" then
If objSubFolders.Name <> "Documents and Settings" then
If objSubFolders.Name <> "temp" then
If objSubFolders.Name <> "RECYCLER" then
If objSubFolders.Name <> "WUTemp" then
If objSubFolders.Name <> "System Volume Information" then
If objSubFolders.Name <> "Program Files" then
If objSubFolders.Name <> "WINDOWS" then
If objSubFolders.Name <> "Microsoft" then
txtNames.WriteLine "C:\" & objSubFolders.Name
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next
txtNames.Close
I'm sure there's a prettier way of performing the exclusions above, but this works, so...
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Set txtNames = FSO.OpenTextFile("C:\FolderNames.txt", 1)

Do Until txtNames.AtEndOfStream
Set objDirectory = FSO.GetFolder(txtNames.readline)
Set TheFiles = objDirectory.Files
'52
Set txtList = FSO.OpenTextFile("C:\List.txt", 8)

WorkWithSubFolders objDirectory
Here's where I get another syntax error...
[COLOR=red yellow]Sub WorkWithSubFolders(objDirectory)[/color]
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub

ListFilesWithExtension objDirectory

Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = "pst") Or (strExt = "pab") Or (strExt = "txt") Or (strExt = "doc ") Or (strExt = "xls") Or (strExt = "mdb") Then
txtList.WriteLine objDirectory & "\" & objFile.Name
End If
Next
End Sub

txtNames.NextLine
Loop
txtNames.Close
txtList.Close
MsgBox("Completed the Scan...")
Wscript.quit

 

[EBGreen]

I didn't really look at the whole thing, but you can refactor this a little:

For Each objSubFolders in objFolders
    If objSubFolders.Name <> "WINNT" then
        If objSubFolders.Name <> "Documents and Settings" then
            If objSubFolders.Name <> "temp" then
                If objSubFolders.Name <> "RECYCLER" then
                    If objSubFolders.Name <> "WUTemp" then
                        If objSubFolders.Name <> "System Volume Information" then
                            If objSubFolders.Name <> "Program Files" then
                                If objSubFolders.Name <> "WINDOWS" then
                                    If objSubFolders.Name <> "Microsoft" then
                                        txtNames.WriteLine "C:\" & objSubFolders.Name
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
Next

Becomes:

For Each objSubFolders in objFolders
  strTestString = "temp" _
    & "Recycler" _
    & "WUTemp" _
    & "System Volume Information" _
    & "Program Files" _
    & "Windows" _
    & "Microsoft"
  If InStr(objSubFolders.Name, strTestString) = False Then  
    txtNames.WriteLine "C:\" & objSubFolders.Name
  End If
Next

Should work and be easier to maintain.

[blue]"Well, once again my friend, we find that science is a two headed beast. One head is nice, it gives us aspirin and other modern conveniences,...but the other head of science is BAD! Oh, beware the other head of science, Arthur; it bites!!" - The Tick[/blue]

 

[PHV]

Here's where I get another syntax error...
Sub WorkWithSubFolders(objDirectory)
The preceding Do loop is not terminated at this point, so move the subs definition at end of the script.

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[DougInCanada]

Thanks, PHV, Did that and it worked fine, except that:

A) The For Each / Next for my file exclusions doesn't work, so I'm back to ugly but effective for the exclusions.

B) I get an access denied during the loop. After some investigation, I found that the subs were not using the foldernames.txt, which excluded problem folders.

I resolved that issue by adding line 53

Set TheFiles = objDirectory.Files

However, I now get an error on line 75 Char 2 "Object not a collection".

If I omit calling the sub WorkWithSubFolders objDirectory, the script runs great, but only uses the folder names enumerated in the FolderNames.txt file and NOT the subfolders they contain.

It's almost there, but I'm at a loss....

Here's the script I have so far, warts and all...


dim FSO, WSH, ObjDirectory, objFile, TheFiles, objFolders, txtList, objSubFolders, txtNames

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set objFolders = FSO.Drives("C").RootFolder.SubFolders

If FSO.FileExists ("C:\FolderNames.txt") then
FSO.DeleteFile "C:\FolderNames.txt"
End If

Set txtNames = FSO.CreateTextFile ("C:\FolderNames.txt")

If FSO.FileExists ("C:\List.txt") then
FSO.DeleteFile "C:\List.txt"
End If
'15
Set txtList1 = FSO.CreateTextFile ("C:\List.txt")
txtList1.Close

For Each objSubFolders in objFolders
If objSubFolders.Name <> "WINNT" then
If objSubFolders.Name <> "Documents and Settings" then
If objSubFolders.Name <> "temp" then
If objSubFolders.Name <> "RECYCLER" then
If objSubFolders.Name <> "WUTemp" then
If objSubFolders.Name <> "System Volume Information" then
If objSubFolders.Name <> "Program Files" then
If objSubFolders.Name <> "WINDOWS" then
If objSubFolders.Name <> "Microsoft" then
txtNames.WriteLine "C:\" & objSubFolders.Name
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next
txtNames.Close
'41
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Set txtNames = FSO.OpenTextFile("C:\FolderNames.txt", ForReading)
Set txtList1 = FSO.OpenTextFile("C:\List.txt", ForAppending)

Do Until txtNames.AtEndOfStream
'50
Set objDirectory = FSO.GetFolder(txtNames.readline)
Removing the next line will run the script with no error messages, but...
WorkWithSubFolders objDirectory
Set TheFiles = objDirectory.Files
ListFilesWithExtension objDirectory
txtNames.SkipLine
Loop
txtNames.Close
txtList.Close

MsgBox("Completed the Scan...")
Wscript.quit

Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub

Sub ListFilesWithExtension(objDirectory)

For Each objFile in TheFiles
[COLOR=red yellow]The next line generates the error message described at the top of this post...[/color]
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = "pst") Or (strExt = "pab") Or (strExt = "txt") Or (strExt = "doc ") Or (strExt = "xls") Or (strExt = "mdb") Then
txtList1.WriteLine objDirectory & "\" & objFile.Name
End If
Next
End Sub

 

[PHV]

Move this line;
Set TheFiles = objDirectory.Files
as the first statement of the Sub ListFilesWithExtension.

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[tsuji]

Hello again,

Or directly appealing to the in-parameter objDirectory:
For Each objFile in objDirectory.Files

I feel uncomfortable with the looseness of the scoping of various variables. But, at least with the last change it would make the script work for the moment.

regards - tsuji

 

[DougInCanada]

Thank you gentlemen!

It may not be pretty, but it certainly works!

I suppose some kind of a looping sub which parses an excludes textfile instead of the list of strings would probably be the best way to modify the script. Then, if you wish to exclude additional folders from the scan, you simply would add them to the Excludes textfile, leaving the script intact.

I try to come back to that when I have some free time, to finish up this thread. Thanks again!