Auto Folder Identification

[Francis]

We have 3 thousand vendor folders with 10 subfolders in each folder.
Many of the subfolders are blank and need to be identified so we can aquire
the information from that vendor to make the folder complete.

Could a script or macro be created to identify the empty folders, either by
changing the color of the folder or anything distinguishing. If a subfolder
is empty, could that primary folder be identified in a list of folders?

 

[Frank]

Try this ... it might get you started -

1. In your "C:\Temp" directory create a folder named "Test"
2. In "C:\Temp\Test" create two folders ... name one "1" and the other "2"
3. In "C:\Temp\Test\2" create an empty .txt file (any name you like)
4. Create a new database and in it make a table named "Folders" with one
text field named "FolderName"
5. In the new database create a new module and copy-paste the following code
into it -

Public Sub DoIt()

Dim s As String
Dim rs As Recordset

DoCmd.SetWarnings False

DoCmd.RunSQL "DELETE FROM Folders"

s = Dir("C:\Temp\Test\", vbDirectory)
While Not Len(s) = 0
If Not s = "." And Not s = ".." Then
DoCmd.RunSQL "INSERT INTO Folders ( FolderName ) SELECT " & s
End If
s = Dir
Wend

Set rs = CodeDb.OpenRecordset("Folders", dbOpenSnapshot)
While Not rs.EOF
FoundAFile = False
s = Dir("C:\Temp\Test\" & rs!FolderName & "\")
While Not Len(s) = 0
If Not s = "." And Not s = ".." Then
FoundAFile = True
End If
s = Dir
Wend
If FoundAFile Then
DoCmd.RunSQL "DELETE FROM Folders WHERE FolderName = '" &
rs!FolderName & "'"
End If
rs.MoveNext
Wend

DoCmd.SetWarnings True
Set rs = Nothing

MsgBox "Done."

End Sub

After you run the code you should have one record in the "Folders" table
with "1" in it.

Move the text file you created from "C:\Temp\Test\2" to "C:\Temp\Test\1" and
run the code again ... you should then have one record in the "Folders" table
with "2" in it.

Cheers ...

 

[Frank]

This is better -

Public Sub DoIt()

Dim s As String
Dim rs As Recordset
Dim FoundAFile As Boolean

DoCmd.SetWarnings False

DoCmd.RunSQL "DELETE FROM Folders"

s = Dir("C:\Temp\Test\", vbDirectory)
While Not Len(s) = 0
If Not s = "." And Not s = ".." Then
DoCmd.RunSQL "INSERT INTO Folders ( FolderName ) SELECT " & s
End If
s = Dir
Wend

Set rs = CodeDb.OpenRecordset("Folders", dbOpenSnapshot)
While Not rs.EOF
FoundAFile = False
s = Dir("C:\Temp\Test\" & rs!FolderName & "\")
While Not (Len(s) = 0 Or FoundAFile)
If Not s = "." And Not s = ".." Then
FoundAFile = True
DoCmd.RunSQL "DELETE FROM Folders WHERE FolderName = '" &
rs!FolderName & "'"
Else
s = Dir
End If
Wend
rs.MoveNext
Wend

DoCmd.SetWarnings True
Set rs = Nothing

MsgBox "Done."

End Sub

 

[Francis]

Frank, this will work out just file. appreciate.

This is better -

Public Sub DoIt()

Dim s As String
Dim rs As Recordset
Dim FoundAFile As Boolean

DoCmd.SetWarnings False

DoCmd.RunSQL "DELETE FROM Folders"

s = Dir("C:\Temp\Test\", vbDirectory)
While Not Len(s) = 0
If Not s = "." And Not s = ".." Then
DoCmd.RunSQL "INSERT INTO Folders ( FolderName ) SELECT " & s
End If
s = Dir
Wend

Set rs = CodeDb.OpenRecordset("Folders", dbOpenSnapshot)
While Not rs.EOF
FoundAFile = False
s = Dir("C:\Temp\Test\" & rs!FolderName & "\")
While Not (Len(s) = 0 Or FoundAFile)
If Not s = "." And Not s = ".." Then
FoundAFile = True
DoCmd.RunSQL "DELETE FROM Folders WHERE FolderName = '" &
rs!FolderName & "'"
Else
s = Dir
End If
Wend
rs.MoveNext
Wend

DoCmd.SetWarnings True
Set rs = Nothing

MsgBox "Done."

End Sub