Delete all subdirectories except two?

I need a bit of code to check a specific directory for subfolders and delete all those subfolders, except for Administrator, All Users and Default User in Windows 2000.


Can anyone provide some help?

Thanks,

aatwell

you'll have to go through checking each folder for the name 'Administrator' is all the subfolders.

How do I check a specific directory for all folders and then delete the ones that aren't "Administrator", "Default User", and "All Users"?

Can you help me?

I really hope so.

Sincerely,
aatwell

Well I could give it a shot! In my attempt I'll use the function Dir() to look for subdirs in a directory, and exclude "Administrator", "Default User" and "All Users". I'll give a simple code, and explain later on.


--------------------------------
Dim NumEx as Long

NumEx = 3

Dim Ex(): ReDim Ex(NumEx)
Dim Location As String
Dim File as String
Dim tNum As Long
Dim FullPath As String

MsgBox "Starting..."

Location = "C:\MyDir\"

Ex(1) = "Administrator"
Ex(2) = "Default User"
Ex(3) = "All Users"

File = Dir(Location & "*")

While File <> ""

DoEvents

FullPath = Location & File

If File <> "." And File <> ".." And _
GetAttr(FullPath) = vbDirectory Then

For tNum = 1 To NumEx
If File = Ex(tNum) Then Goto 1
Next

' Whatever you wonna do with it.

1
End If

File = Dir

Wend

MsgBox "Done!"
--------------------------------

*****, gotta eat. Well, I hope you will understand this code as it is now, otherwise just say so!


Quintonir

Hey Quintonir,

It runs with no errors but doesn't delete the dirs or any files inside it.

I added the line to kill the FullPath but it didn't do it.

' Whatever you wonna do with it.
Kill (FullPath)


Any clues?

aatwell

So you understand the code I gave? That's good. Now the folder deleting... What the function 'Kill()' (and the API Function 'DeleteFile()') expects is a file. If you give a folder, the function can't find the file because it's not given. I know one other API Call, but there's a little problem. The API is: RemoveDirectory. It removes specified directory. BUT: The directory must be COMPLETELY empty, or it will fail. Assuming you want to loose all contents of the folder, I'll give you a code, below (errors possible):

--------------------------
Dim SearchDir As String
Dim DirNum As Long
Dim Asterisk As String
Dim File As String
Dim CurDir As Long
Dim Directory(): ReDim Directory(10000)

Asterisk = "*"

Station = "C:\MyDir\"

For v = 1 To 10000
Directory(v) = ""
Next

DirNum = 0

SearchDir = ""
CurDir = 0

Directory(1) = Station
DirNum = 1

' >> First list all directories

SearchDir = Station
File = Dir(FixDir(SearchDir) & Asterisk, vbDirectory)

While File <> ""

DoEvents

If File = "." Or File = ".." Then GoTo 5
If GetAttr(FixDir(SearchDir) & File) <> vbDirectory Then GoTo 5

DirNum = DirNum + 1
Directory(DirNum) = FixDir(SearchDir) & File
5
File = Dir

Wend

2

CurDir = 1

While CurDir < DirNum

CurDir = CurDir + 1
SearchDir = Directory(CurDir)

File = Dir(FixDir(SearchDir) & Asterisk, vbDirectory)

While File <> ""

DoEvents

If File = "." Or File = ".." Then GoTo 4
If GetAttr(FixDir(SearchDir) & File) <> vbDirectory Then GoTo 4

DirNum = DirNum + 1
Directory(DirNum) = FixDir(SearchDir) & File
4
File = Dir

Wend

3
Wend

' >> All dirs within 'Station' are listed
' >> First we kill all files, then kill dir

Dim RetVal

For v = DirNum To 1 Step -1

DoEvents

File = Dir(FixDir(Directory(v)) & Asterisk)
While File <> ""
On Error GoTo 4333

If File = "." Or File = ".." Then GoTo 4333

' >> Your code to kill the found file!!
' >> I don't know your prefers :D
' >> Simply use GetAttr()
' to check what file it is
' >> Simply use Kill() to kill file!
' >> Remember, when file cannot be
' deleted, dir <> empty, and
' RemoveDirectory will fail!!

4333
File = Dir
Wend

' >> The files are gone!
' >> Let's take out the dir!

RetVal = RemoveDirectory(Directory(v))
If RetVal = 1 Then
' >> Success!
Else
' >> Failed! :(
' >> Do something!
End If
Next
------------------------

Sorry if it's too long or something, I ain't no professional VB programmer! Also, non-error is not 100% guaranteed. This code simply empties the whole dir (at least, that's his purpose) and at last he kills the dir hisself. (Tip: Make some inlining (punctation on the left) yourself, as this BBoard takes it away.) Hope it helps post something back if it gives an error or something!

Bye,


Quintonir

I am getting ready to compile and try this.

Just wondering if it will delete subdirectories in those directories?


Like this.....

Administrator: 'not deleted
Default User: 'not deleted
All Users: 'not deleted
'Below will be deleted

username1
..username1subfolder1
....textfile
....subfolder1subfolder
....textfile
..username1subfolder2
....subfolder2subfolder
....textfile

username2
..username2subfolder1
....subfolder1subfolder
..username2subfolder2
....subfolder2subfolder

That is directories inside directories inside directories.

Suppose I'll find out in a few minutes....


aatwell

Yes, it takes care of all subdirectories, BUT IT ALSO KILLS THE DIRECTORY ITSELF (in my example that will be C:\MyDir) !!!!! That Dir is located at Directory(1), so in the last For...Next EXCLUDE v = 1 !!

Hope the code works ...



Quintonir

It tells me that FixDir is not declared. Should I declare it as a string or something else?

Also the only v=1 I find is at:

For v = 1 To 10000
Directory(v) = ""
Next

Is this where I exclude v=1?

thanks,
aatwell

Oh I'm so sorry - FixDir is a function which fixes the problem that the return value of the Dir() function (when found a folder) doesn't include a "\" on the right. Function:

---------------------
Function FixDir(Folder)

Dim T

If Right(Folder, 1) <> "\" Then T = "\"

FixDir = Folder & T

End Function
---------------------

I agree my codings are not well viewable, it's hard to find out what's happening, isn't it ? When you need help, I'll be there. Gotta go now (15-3-'01) so I'll answer tomorrow.


Quintonir

Now, that's not the last one. Pick the For...Next where all the files and dirs are getting killed, and implement something like "If v = 1 then goto HellIKnowWhat" or something :D


Quintonir

Ok. Were getting there [I think].

It tells me that "RemoveDirectory" is not defined either.

Can you post that function as well.. Looking forward to hearing from you tomorrow [16-03-'01]. See ya.

aatwell

That function is an API Call. Put the following declaration in a module (*.bas):

--------------------
Declare Function RemoveDirectory Lib "kernel32.dll" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long
--------------------

(It declares to VB a function RemoveDirectory, located in kernel32.dll, in this dll the function is under the name "RemoveDirectoryA", it has one expected argument and returns a Long-value.

Hope the code works,


Quintonir

Can you please modify this bit of code to just give one group of variables [directory()] that will contain all existing directories in the station directory?

I think if I can just get this, i'll have this project licked.

Thanks....


' >> First list all directories

SearchDir = Station
File = Dir(FixDir(SearchDir) & Asterisk, vbDirectory)

While File <> ""

DoEvents

If File = "." Or File = ".." Then GoTo 5
If GetAttr(FixDir(SearchDir) & File) <> vbDirectory Then GoTo 5

DirNum = DirNum + 1
Directory(DirNum) = FixDir(SearchDir) & File
5
File = Dir

Wend

2

CurDir = 1

While CurDir < DirNum

CurDir = CurDir + 1
SearchDir = Directory(CurDir)

File = Dir(FixDir(SearchDir) & Asterisk, vbDirectory)

While File <> ""

DoEvents

If File = "." Or File = ".." Then GoTo 4
If GetAttr(FixDir(SearchDir) & File) <> vbDirectory Then GoTo 4

DirNum = DirNum + 1
Directory(DirNum) = FixDir(SearchDir) & File
4
File = Dir

Wend

3
Wend

' >> All dirs within 'Station' are listed

I'm sorry, but I do not understand your question. All Directories found are located in the array Directory(). Directory(1) contains the directory of the folder in Station ("C:\MyDir\") and the rest have subdirs. Then, "' >> All dirs within 'Station' are listed" doesn't say the dirs are listed in Station, but all subdirs IN the dir in variable Station are listed (Directory()).

Hope this helps,


Quintonir

Quintonir,

Sorry for the misunderstanding. The reason I asked to modify the
above code is because it gives me 64 directory(v) when I infact have
only 7 directories. It makes the first directory to be "." not station.

Something is wrong and I can't figure it out. I am hoping that you'll be
able to resolve this problem.

Let me know and thanks for all your help.

aatwell

Fixing the problem right now!!

Sorry for the problems ...

I am heading out the door to go out and eat.

I'll look forward to your response when I return.

Thanks a million.

aatwell

I'm very sorry but I've tested the code in the following format (I've added the ListBox lstPath to Form1):

------------------
Private Sub Form_Load()

Dim CurDir As Long
Dim SearchDir As String
Dim File As String
Dim DirNum As Long
Dim Directory(): ReDim Directory(10000)
Dim Asterisk

Asterisk = "*"

Station = "C:\WINDOWS\Desktop\"

SearchDir = Station
File = Dir(FixDir(SearchDir) & Asterisk, vbDirectory)

While File <> ""

DoEvents

If File = "." Or File = ".." Then GoTo 5
If GetAttr(FixDir(SearchDir) & File) <> vbDirectory Then GoTo 5

DirNum = DirNum + 1
Directory(DirNum) = FixDir(SearchDir) & File
5
File = Dir

Wend

2

CurDir = 1

While CurDir < DirNum

CurDir = CurDir + 1
SearchDir = Directory(CurDir)

File = Dir(FixDir(SearchDir) & Asterisk, vbDirectory)

While File <> ""

DoEvents

If File = "." Or File = ".." Then GoTo 4
If GetAttr(FixDir(SearchDir) & File) <> vbDirectory Then GoTo 4

DirNum = DirNum + 1
Directory(DirNum) = FixDir(SearchDir) & File
4
File = Dir

Wend

For v = 1 To DirNum
DoEvents
lstPath.AddItem Directory(v)
Next

3
Wend

End Sub

-------------

Function FixDir(Station)

If Station <> "" And Right(Station, 1) <> "\" Then
FixDir = Station & "\"
Else
FixDir = Station
End If

End Function
----------------------

I coul'n't find any problem, it perfectly listed the directories below C:\WINDOWS\Desktop\. Maybe you should list all Directory() in a ListBox and view them all? I don't have time now, but tomorrow, when you've hadn't post anything yet, I'll check the entire code.

Gotta go now,


Quintonir

To list all subdirectories from a path, you could try using jScan. Download the attachment and set a reference to it.

Code:

---

Private Sub Command1_Click()
Dim results As Variant, i As Long
results = jScan("C:\WINDOWS\Desktop\*.*", True, Attribute_Directory) 'use jScan To return array of all folders In C:\WINDOWS\Desktop\

If Not IsNull(results) Then

  For i = 0 To UBound(results)

      List1.AddItem results(i)
  Next i
 
Else
  Me.List1.AddItem "No matching Results"
End If
 
End Sub

---

Maybe this will help

JamesM,

How do I set a reference to the jscan dll?

aatwell

aatwell,

From the project menu , select references. Then click browse, and browse to where you saved the dll.

The other way of doing it is to choose run from the start menu, and then type:

regsvr32 dllpath (to register dll)
or
regsvr32 /u dllpath (to unregister dll)

Once registered, the dll is always available as a reference from the project\references menu without having to click browse.

Note: if you are going to move the dll, unregister it before moving it, then reregister it again.

Hope this helps