Permission Issue With Accessing Subfolder 2

[JustScriptIt]

I modified the script from

http://www.tek-tips.com/viewthread.cfm?qid=1635255

Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim strDir, objDir
strDir = "d:\"
Set objDir = FSO.GetFolder(strDir)
PrintFiles(objDir)

Sub PrintFiles(pCurrentDir)
    Dim aItem, sBaseName
    
   
   For Each aItem In pCurrentDir.Files
      If fso.GetExtensionName(aItem.Path) = "vbs" Then
         sBaseName = fso.GetParentFolderName(aItem.path) & _
              fso.GetBaseName(aItem.path)

         Wscript.echo sBaseName
         Wscript.echo

         
      End If
   Next

 
   For Each aItem In pCurrentDir.SubFolders
      PrintFiles(aItem)
   Next


End Sub

When I execute one of the subfolder causes

(14, 4) Microsoft VBScript runtime error: Permission denied

When I execute in debug mode, the program reaches

For Each aItem In pCurrentDir.SubFolders
      PrintFiles(aItem)

Few times beore it throws the runtime error.

How to troubleshoot?

 

[jges]

It appears that you don't have permissions on one or more of the subfolders on the D drive.

Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim strDir, objDir
strDir = "d:\"
Set objDir = FSO.GetFolder(strDir)
PrintFiles(objDir)

Sub PrintFiles(pCurrentDir)
    Dim aItem, sBaseName
    
   
   For Each aItem In pCurrentDir.Files
      If fso.GetExtensionName(aItem.Path) = "vbs" Then
         sBaseName = fso.GetParentFolderName(aItem.path) & _
              fso.GetBaseName(aItem.path)

         Wscript.echo sBaseName
         Wscript.echo

         
      End If
   Next

 
   For Each aItem In pCurrentDir.SubFolders
      [COLOR=blue yellow]Wscript.echo(aItem)[/color]
      PrintFiles(aItem)
   Next


End Sub

Add the line highlighted above and take note of the last folder name returned before the error occurs.

 

[JustScriptIt]

Now I modified the code to handle the permissions error, but now I have another problem.

If the program sees a .vbs file in the d:\ directory, it prints it as

d:\\file.vbs

but if the .vbs is in a subdirectory, it prints fine, i.e.

d:\folder\file.vbs

How to correct this? Below is code:

{CODE]
Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim strDir, objDir
strDir = "d:\"
Set objDir = FSO.GetFolder(strDir)


''''''''''Declare Sub Routines''''''''''

Sub HandleError()
On Error Goto 0
Err.Clear
End Sub

Sub PrintFiles(pCurrentDir)
Dim aItem, sBaseName


For Each aItem In pCurrentDir.Files
If fso.GetExtensionName(aItem.Path) = "vbs" Then
sBaseName = fso.GetParentFolderName(aItem.path) & _
"\" & fso.GetBaseName(aItem.path)

Wscript.echo sBaseName
Wscript.echo


End If
Next

On Error Resume Next
For Each aItem In pCurrentDir.SubFolders
If (Err.Number <> 0) Then
HandleError()
Wscript.echo aItem & " cannot be accessed"
Wscript.echo
Else
PrintFiles(aItem)

End If
Next


End Sub


''''''''''End of Sub Routine Declaration''''''''''

PrintFiles(objDir)
[/CODE]

 

[PHV]

Why not replace this:
strDir = "d:\"
with this ?
strDir = "d:"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[JustScriptIt]

I tried replacing d:\ with d:, nut I get the same output :-(

 

[guitarzan]

This is because GetParentFolderName returns a "\" when the file is in the root. You will need to look at the GetParentFolderName result, and either strip off the extra \ if it's present, or avoid adding another \ when it is present.

 

[JustScriptIt]

It worked. See modified subroutine for PrintFiles

Sub PrintFiles(pCurrentDir)
	Dim aItem, sParentName, sBaseName
    
   	
	For Each aItem In pCurrentDir.Files
		If fso.GetExtensionName(aItem.Path) = "vbs" Then
	
			If Right(fso.GetParentFolderName(aItem.path),1) = "\" Then
				sParentName = Replace(fso.GetParentFolderName(aItem.path),"\","")
			Else
				sParentName = fso.GetParentFolderName(aItem.path)
			End If

			sBaseName = sParentName & _
				"\" & fso.GetBaseName(aItem.path)

			Wscript.echo sBaseName
			Wscript.echo

         
		End If
   	Next

 	On Error Resume Next
	For Each aItem In pCurrentDir.SubFolders	
		If (Err.Number <> 0) Then
	  		HandleError()
			Wscript.echo aItem & " cannot be accessed"
			Wscript.echo
		Else
			PrintFiles(aItem)
	
		End If
   	Next


End Sub