Obtain file from subfolders

  • Thread starter Thread starter Noemi
  • Start date Start date
N

Noemi

Hi
I have used the coding which has been provided by others to be able to
select a folder which contains subfolders however I seem to be having
problems obtaing the files from the subfolders. At the moment with the code
all it brings back is the subfolders name when I actually also need the file
name with the extension for fule type.

Below is the code which I had copied but I must be missing something because
it doesn't seem to show me the file name.

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window.
' The list box must have its Row Source Type property set
to Value List.
'Method: FilDir() adds items to a collection, calling itself
recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant
Stop
strPath = strFolderName
Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
For Each varItem In colDirList
lst.AddItem varItem
Next
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolderName As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim strTemp2 As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim strFileName As String
Dim strF As String
Dim strF2 As String
Dim strF3 As String


Set db = DBEngine(0).OpenDatabase(stDatabase)
Set rs = db.OpenRecordset("pages", 2)
Set rs2 = db.OpenRecordset("export", 2)

' strFileSpec = "\*jpg"

'Add the files to the folder.
strFolderName = TrailingSlash(strFolderName)
strTemp = Dir(strFolderName & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolderName & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolderName, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then

'strF = Left(strTemp, 3)
'strF = Len(strTemp) - 3
If (GetAttr(strFolderName & strTemp) And vbDirectory) <> 0&
Then
strTemp2 = Dir(strFolderName, strFileSpec)
If Right(strTemp2, 3) = "JPG" Then
Stop
strFileName = Left(strTemp, 4) & ".TIF"
rs.MoveFirst
rs.FindFirst "[Image_File_Name]=""" & strFileName &
"AND [Document_ID]=""" & strF2 & """"
If Not rs.NoMatch Then
rs.Edit
rs.Fields(2) = strTemp
rs.Update
blnFound = True
Else
blnMissing = True
End If
Else
strTemp2 = Dir
End If
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolderName &
TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function
 
Dont worry about this one as I have worked it out.

However, does anyone know how to remove the C:\ and the next folder name
from a string.

Thanks
Noemi

Noemi said:
Hi
I have used the coding which has been provided by others to be able to
select a folder which contains subfolders however I seem to be having
problems obtaing the files from the subfolders. At the moment with the code
all it brings back is the subfolders name when I actually also need the file
name with the extension for fule type.

Below is the code which I had copied but I must be missing something because
it doesn't seem to show me the file name.

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
not, files are listed to immediate window.
' The list box must have its Row Source Type property set
to Value List.
'Method: FilDir() adds items to a collection, calling itself
recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant
Stop
strPath = strFolderName
Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
For Each varItem In colDirList
lst.AddItem varItem
Next
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolderName As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim strTemp2 As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim strFileName As String
Dim strF As String
Dim strF2 As String
Dim strF3 As String


Set db = DBEngine(0).OpenDatabase(stDatabase)
Set rs = db.OpenRecordset("pages", 2)
Set rs2 = db.OpenRecordset("export", 2)

' strFileSpec = "\*jpg"

'Add the files to the folder.
strFolderName = TrailingSlash(strFolderName)
strTemp = Dir(strFolderName & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolderName & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolderName, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then

'strF = Left(strTemp, 3)
'strF = Len(strTemp) - 3
If (GetAttr(strFolderName & strTemp) And vbDirectory) <> 0&
Then
strTemp2 = Dir(strFolderName, strFileSpec)
If Right(strTemp2, 3) = "JPG" Then
Stop
strFileName = Left(strTemp, 4) & ".TIF"
rs.MoveFirst
rs.FindFirst "[Image_File_Name]=""" & strFileName &
"AND [Document_ID]=""" & strF2 & """"
If Not rs.NoMatch Then
rs.Edit
rs.Fields(2) = strTemp
rs.Update
blnFound = True
Else
blnMissing = True
End If
Else
strTemp2 = Dir
End If
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolderName &
TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function
Click to expand...
 
Back
Top