searching for file in folders/subfolders, permission denied 2

[kokser]

Here is my script

strDir = "C:\Users\dude\Desktop"
Set FSO1 = CreateObject("Scripting.FileSystemObject")
Set objDir = FSO1.GetFolder(strDir)
getInfo(objDir)

Sub getInfo(pCurrentDir)

For Each aItem In pCurrentDir.Files
If LCase(Right(Cstr(aItem.Name), 3)) = "rdp" Then
Set FSO2 = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO2.OpenTextFile(aItem.Name, 1, False, -1)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "10.30.12.32", "999")
Set objFile = FSO2.OpenTextFile(aItem.Name, 2, False, -1)
objFile.WriteLine strNewText
objFile.Close
End If
Next

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

End Sub

This works perfectly fine. It searches the desktop and subfolders for RDP shortcuts, and edits the IP.

I tried changing the strDir to a level higher, so C:\Users\dude\ but then I get Permission Denied at line 8 (first For Each). I tried changing to a bunch of difference paths, but it only works with the desktop path, and I simply cannot figure out why. I AM administrator, I even tried starting the script through cmd running as Administrator. I have checked all the folders in \users\ and made sure I have full control permissions as administrator.

 

[kokser]

Um, okay. Your last post from 11 Apr 11 2:13 says exactly the opposite, but okay.

I think you misunderstood me Making the script run from anything but C:\Users\any username\Desktop does not work. If I make it run from C:\Users (the goal) and using On Error Resume Next at each For Each loop the script will obviously finish, but not edit anything (I put rdp files in different subfolders to see if it could edit anything at all) because of the permission error.

Anyway, changing the Name to Path property, the script still works so far.

Alright so I did added the error description to the script

dim arrInvalidFolders(1)
arrInvalidFolders(0) = "AppData"
arrInvalidFOlders(1) = "Application Data"

Function isValid(strDir)
isValid = True
For Each strInvalidFolders in arrInvalidFolders
If (objDir.Path = strInvalidFolder) Then
isValid = False
End If
Next
End Function

strDir = "C:\Users"
Set FSO1 = CreateObject("Scripting.FileSystemObject")
Set objDir = FSO1.GetFolder(strDir)
getInfo(objDir)

Sub getInfo(objDir)
If (isValid(objDir.Path)) Then
On Error Resume Next
For Each aItem In objDir.SubFolders
If (err.number <> 0) Then
msgbox "MySub: " & err.description
End if
getInfo(aItem)
Next
For Each aItem In objDir.Files
If LCase(Right(Cstr(aItem.Path), 3)) = "rdp" Then
Set FSO2 = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO2.OpenTextFile(aItem.Path, 1, False, -1)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "10.30.12.32", "999")
Set objFile = FSO2.OpenTextFile(aItem.Path, 2, False, -1)
objFile.WriteLine strNewText
objFile.Close
End If
Next
End If
Set FSO2 = nothing
End Sub

msgbox "Done"

MySub: Permission Denied

I liked the old error box better

 

[guitarzan]

I liked the old error box better

So your script to modify RDP files didn't work before and after, but you liked the old error box better? (just joking...)

This was a weird one... I don't have a Vista/7 machine to test, so I tested the script as a limited user in XP, and yes, I found it difficult to get the script to ignore folders that I didn't have permission to. The problem is that the "For Each aItem In objDir.SubFolders" line itself gives "permission denied" errors. I seem to have gotten it to work in XP as a limited user. In my playing, I changed the logic a bit... First, I traverse the files in the given folder, and then recursively call the routine with each SubFolder found. The "On Error Resume Next" should just skip over the folders that you do not have permission to.

dim arrInvalidFolders(1)
arrInvalidFolders(0) = "AppData"
arrInvalidFOlders(1) = "Application Data"

strDir = "C:\Users"
Set FSO1 = CreateObject("Scripting.FileSystemObject")
Set objDir = FSO1.GetFolder(strDir)
getInfo(objDir)


Sub getInfo(objDir)

   If (isValid(objDir.Path)) Then
      On Error Resume Next
      For Each aFile In objDir.Files
         If Err.number = 0 Then
            On Error Goto 0
            If LCase(Right(Cstr(aFile.Name), 3)) = "rdp" Then
               MsgBox "Found RDP: " & aFile.path
               Set FSO2 = CreateObject("Scripting.FileSystemObject")
               Set objFile = FSO2.OpenTextFile(aFile.Path, 1, False, -1)
               strText = objFile.ReadAll
               objFile.Close
               strNewText = Replace(strText, "10.30.12.32", "999")
               Set objFile = FSO2.OpenTextFile(aFile.Path, 2, False, -1)
               objFile.WriteLine strNewText
               objFile.Close
            End If
         End If
      Next

      For Each aItem In objDir.SubFolders
         If Err.number = 0 Then 
            getInfo(aItem)
         End If
         On Error Resume Next
      Next
   End If
	
   msgbox "Done"
End Sub

Function isValid(strDir)
   isValid = True
   For Each strInvalidFolders in arrInvalidFolders
      If (objDir.Path = strInvalidFolder) Then
         isValid = False
      End If
   Next
End Function

 

[Geates]

What I've found is that On Error Resume NEXt only seems to apply to the scope in which it is defined.

on error resume next
For Each aItem In objDir.SubFolders
    If Err.number = 0 Then
        getInfo(aItem)
    End If
next 
msgbox "hi"

With the issues at hand, one would expect this loop to iterate through every item in objDir.SubFolders even if an error occurs. However, this is not the case! As soon as an error occurs, the next command isn't the next iteration of the loop, but rather, msgbox "hi". This is because the on error resume next is defined OUTSIDE the scope of the for...loop.

By simply moving the on error resume next within the for..loop scope, iterations will still continue.

For Each aItem In objDir.SubFolders
    on error resume next

    If Err.number = 0 Then
        getInfo(aItem)
    End If
next 
msgbox "hi"

Consider, "on error resume next" to really be "on error resume next in scope"

-Geates

NOTE: This may not be completely accurate, but then again, it is what I have observed.

In the voice of the Dos Equis Most Interesting Man in the World: "I don't always test my code. But when I do, I do it in production

 

[kokser]

Absolutely awesome! It works perfect! I used guitarzan's script and modified it with Geates last post, and now it works!

I am very happy, this script will save me a lot of time Thank you both so much for helping