Start from top to bottom

[bdthomas02]

Hello everyone,

I am trying to access a folder via way of an API call. I have included the code I am using at the end of this message for everyone to view. The code allows me to choose a folder but I need to start at the Main Directory and go through folders 1 and 2 and each subfolder for a particular file (e.g. txt, doc, jpeg, etc.). I need to be able to locate a certain file extension in each folder.

e.g. Main Dir--
Folder1--
Subfolder--
Folder2--
Subfolder--

The code I am using is missing some files. Can anyone out there lend me a hand or tell me what I am missing in my code?

Here is the code:

Option Compare Database

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function


Thanks,

bdthomas02

[Mavyak]

I don't fully understand what you want to do but maybe the following code will get you started. It will loop through all the first level sub-folders of the folder you specify in the annotated line and print the file path and name in the immediate window. It also does not require an API call. You will need to set a reference to the "Microsoft Scripting Runtime Library" for the code to work. Have a go at it and post back with any tweaks you need and we'll get you hooked up.

Sub get_files()
On Error GoTo errHandler
Dim fso As FileSystemObject
Dim fldr As Folder
Dim f As File

Set fso = New FileSystemObject

For Each fldr In fso.GetFolder("C:\").SubFolders 'Replace "C;\" with your "Main" folder name
For Each f In fldr.Files
Debug.Print f.Path
Next f
PermissionDenied:
Next fldr
ExitSub:
Set f = Nothing
Set fldr = Nothing
Set fso = Nothing
Exit Sub
errHandler:
If Err.Description = "Permission denied" Then
Err.Clear
Resume PermissionDenied
Else
Debug.Print Err.Description
Stop
Err.Clear
End If
Resume Next
End Sub

[bdthomas02]

This is what I am trying to do:

There is a main folder called "Everything" and three subfolders inside of Everything. One of the subfolders inside Everything is called "Capture" and inside of Capture is three subfolders. One of the subfolders inside of Capture is called "Look" and inside of Look is three subfolders. One of the subfolders inside of Look is called "Here" and inside of Here is three subfolders. This is the folder tree:
Everything-
folder 1
folder 2
Capture-
folder 1
folder 2
Look-
folder 1
folder 2
Here-
folder 1
folder 2
folder 3

In each folder beginning with Everything is different file types. The file types consist of .doc, .txt, .xml, .jpg, .rtf, etc. I want to go through each folder in the folder tree and extract all .txt files and import into Access. I want to be able to click Everything and the code automatically search each folder in the tree to find only the .txt files and import to Access. Is this a more detailed description? If not let me know.

Thanks,

bdthomas02

[CreganTur]

Here's a really good kb article from mdmackillop (http://www.vbaexpress.com/kb/getarticle.php?kb_id=245) that will show you how to loop through all files in a folder and its subfolders.

It should give you a good starting point for the main part of your program- navigating through your folders.

[Mavyak]

Option Compare Database
Sub ListFiles()
Dim f As FileDialog
Dim yn As Integer

Set f = Application.FileDialog(msoFileDialogFolderPicker)

With f
.AllowMultiSelect = False
.ButtonName = "Select"
.Title = "Select the folder to search..."
.Show
If .SelectedItems.Count > 0 Then
yn = MsgBox("Search subfolders of:" & vbCr & vbCr & .SelectedItems(1), vbYesNoCancel, "Need some more info here...")
Select Case yn
Case Is = vbYes
GetTextFiles .SelectedItems(1), True
Case Is = vbNo
GetTextFiles .SelectedItems(1), False
Case Else
GoTo ExitSub
End Select
Else
GoTo ExitSub
End If
End With
ExitSub:
Set f = Nothing
End Sub

Private Sub GetTextFiles(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim fso As FileSystemObject
Dim sourcefldr As Folder
Dim subfldr As Folder
Dim f As File
Dim r As Long

Set fso = New Scripting.FileSystemObject
Set sourcefldr = fso.GetFolder(SourceFolderName)

For Each f In sourcefldr.Files
If UCase(Right(f.Path, 4)) = ".TXT" Then
Debug.Print f.Path
End If
Next f

If IncludeSubfolders Then
For Each subfldr In sourcefldr.SubFolders
GetTextFiles subfldr.Path, True '<-- Let's get recursive!!
Next subfldr
End If

Set f = Nothing
Set sourcefldr = Nothing
Set subfldr = Nothing
Set fso = Nothing
End Sub

Stolen and modified from: http://www.ozgrid.com/forum/showthread.php?t=44464

[bdthomas02]

How do I test this? I tried running the module from a command button but received an error.

[Mavyak]

Private Sub Command1_Click()
ModuleName.ListFiles
End Sub
Replace "ModuleName" with the name of the module you put the code in. If the code is in the same form module as your command button, remove "ModuleName." from the command so it is just "ListFiles". If you get an error, please convey what the error is so I/we can deduce the problem.

Currently, the code is set up to display the file paths to the immediate window. To change the action performed on each file, edit this line:
Debug.Print f.Path

Also, you will need to set a reference to the "Microsoft Scriptiing Runtime Library" to use the FileSystemObject. You can do that by opening the VBE window and going to Tools-->References and placing a checkmark next to "Microsoft Scriptiing Runtime Library".

[bdthomas02]

I keep getting an error message saying "User-defined type not defined" for the FileDialog. The error occurs at this line of the code "Dim f As FileDialog". What is going on? I have a check mark next to the Microsoft Scriptiing Runtime Library.

Thanks,

bdthomas02

[Mavyak]

I don't fully understand why but in order to use the FileDialog you have to set a reference to the "Microsoft Office xx.0 Object Library". The xx.0 will likely be 11.0 or 12.0 (it's 12.0 on my machine). Even though the object browser says the FileDialog object belongs to the Access.Application, apparently it needs the Office reference as well. I must have had that reference already set in the database I was using to write the code. I removed that reference and my code crashed due to the user-type error you received. When I set the reference, the code worked fine.