RE: Auto Folder Identification

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

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

"Frank" wrote:

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 ...




"Francis" wrote:

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?
.

Relevant Pages

  • Re: Enumerating values in a field in a table
    ... the Do Until EOF strategy and got my 300+ folders made in a jiffy. ... Dim db As DATABASE, rst As Recordset, str As String ... You'll need to open a Recordset based on the table and loop through it. ...
    (microsoft.public.access.modulesdaovba)
  • RE: Auto Folder Identification
    ... Dim rs As Recordset ... Dim FoundAFile As Boolean ... DoCmd.RunSQL "DELETE FROM Folders" ...
    (microsoft.public.access.modulesdaovba)
  • RE: Auto Folder Identification
    ... In the new database create a new module and copy-paste the following code ... DoCmd.RunSQL "DELETE FROM Folders" ... FoundAFile = False ... Could a script or macro be created to identify the empty folders, ...
    (microsoft.public.access.modulesdaovba)
  • Macro for Customized Archiving
    ... from many folders in inbox to different PST folders ... The ArchiveMyMails() routine calls the above multiple times to move ... Dim objInbox As Outlook.MAPIFolder ... Dim objFolder As Outlook.MAPIFolder ...
    (microsoft.public.outlook.program_vba)
  • Re: Size On Disk
    ... Here is some code I wrote a while ago to count the files and folders in any selected drive or folder and report the number of files and folders found together with their total file size and their total size on disk. ... Private Declare Sub CopyMemory Lib "kernel32" _ ... ByVal sDir As String) As Long ... Dim s1 As String, sectorsPerCluster As Long ...
    (microsoft.public.vb.general.discussion)