Finding, Comparing folder names then opening explorer

  • Thread starter Thread starter DawnTreader
  • Start date Start date
D

DawnTreader

Hello

i tried posting this earlier, but something seems to be wrong with either my
browser or the site, so...

i have a project where i have a field that stores the serial number of a
product. i need to take the field, trim it to 5 characters and then use it to
search a folder and all the subfolders, trimming thier names to the first 5
characters, and then capture the full name of the folder, and use that to
open windows explorer at the found folder.

so if i have a field with the value "08003" and i want to find that
sub-sub-subfolder in the folder "c:\WO\" and then open explorer when it finds
the subfolder "C:\WO\Compressor\1 Completed\08003 Airport Petrocan\", what
functions and code do i need?
 
Hi Dawn

A bit longwinded but here is the code taht finds all the files on your c drive

1. First set up a table called "tbl_FilesInFolders"

Filelds
FileInFolderID = AutoNumber
FolderName = Text 255
FileName = Text 255

Copy and Run the following code

Option Compare Database
Option Explicit

Public Function fFileinFolder() As Long
On Error Resume Next

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim intStart As Integer
Dim lngFiles As Long
Dim lngFilesCount As Long
Dim strFile As String
Dim strDir As String
Dim strDirFile As String
Dim strSQL As String
Dim fs As Object
Dim rstDetail As Object
Dim lngTotalErrors As Long
Dim strFolder As String
Dim strFoundInFolder As String

On Error GoTo FileinFolder_Error

lngTotalErrors = 0
strFolder = "C:\"

'-- Delete Contents of Existing Table
DoCmd.RunSQL ("DELETE * FROM tbl_FilesInFolders;")




'-- Trap directory not found
If Dir(strFolder, vbDirectory) = "" Then
MsgBox "Directory Not Found:" & vbCrLf & strFolder, vbCritical,
"Audit File List"
GoTo FileinFolder_Exit
End If


'-- Set up files used
Set dbs = CurrentDb
Set fs = Application.FileSearch

Set rstDetail = dbs.OpenRecordset("tbl_FilesInFolders", dbOpenDynaset)


'-- Look into Folders

With fs
.lookin = strFolder
.SearchSubFolders = True
.FileName = "*.*" 'search for all file
'if just say excel then .FileName =
"*.XLS"

If .Execute() > 0 Then



DoCmd.Hourglass True

lngFilesCount = .foundfiles.Count

'-- Get Data in a loop
For lngFiles = 1 To lngFilesCount
On Error Resume Next

'-- Full path & file name
strDirFile = .foundfiles(lngFiles)

'-- Get file & dir names
intStart = LastInStr(strDirFile, "\")
strFoundInFolder = Left(strDirFile, intStart)

strFile = Mid$(strDirFile, intStart + 1)
'-- Write data to file
rstDetail.AddNew

rstDetail!FolderName = strFoundInFolder
rstDetail!FileName = strFile

rstDetail.Update



Next lngFiles
Else
MsgBox "No files were found in the directory.", vbInformation,
"File List"
End If
End With



FileinFolder_Exit:
On Error Resume Next
rst.Close
rstDetail.colse
Set dbs = Nothing
Exit Function

FileinFolder_Error:
MsgBox Err.Description, vbCritical, "File List Error"
Resume FileinFolder_Exit

End Function
Function LastInStr(strSearched As String, strSought As String) As Integer
Dim intCurrVal As Integer, intLastPosition As Integer

intCurrVal = InStr(strSearched, strSought)

Do Until intCurrVal = 0
intLastPosition = intCurrVal
intCurrVal = InStr(intLastPosition + 1, strSearched, strSought)
Loop

LastInStr = intLastPosition

End Function
 
sorry for the double post.

Trever B said:
Hi Dawn

A bit longwinded but here is the code taht finds all the files on your c drive

1. First set up a table called "tbl_FilesInFolders"

Filelds
FileInFolderID = AutoNumber
FolderName = Text 255
FileName = Text 255

Copy and Run the following code

Option Compare Database
Option Explicit

Public Function fFileinFolder() As Long
On Error Resume Next

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim intStart As Integer
Dim lngFiles As Long
Dim lngFilesCount As Long
Dim strFile As String
Dim strDir As String
Dim strDirFile As String
Dim strSQL As String
Dim fs As Object
Dim rstDetail As Object
Dim lngTotalErrors As Long
Dim strFolder As String
Dim strFoundInFolder As String

On Error GoTo FileinFolder_Error

lngTotalErrors = 0
strFolder = "C:\"

'-- Delete Contents of Existing Table
DoCmd.RunSQL ("DELETE * FROM tbl_FilesInFolders;")




'-- Trap directory not found
If Dir(strFolder, vbDirectory) = "" Then
MsgBox "Directory Not Found:" & vbCrLf & strFolder, vbCritical,
"Audit File List"
GoTo FileinFolder_Exit
End If


'-- Set up files used
Set dbs = CurrentDb
Set fs = Application.FileSearch

Set rstDetail = dbs.OpenRecordset("tbl_FilesInFolders", dbOpenDynaset)


'-- Look into Folders

With fs
.lookin = strFolder
.SearchSubFolders = True
.FileName = "*.*" 'search for all file
'if just say excel then .FileName =
"*.XLS"

If .Execute() > 0 Then



DoCmd.Hourglass True

lngFilesCount = .foundfiles.Count

'-- Get Data in a loop
For lngFiles = 1 To lngFilesCount
On Error Resume Next

'-- Full path & file name
strDirFile = .foundfiles(lngFiles)

'-- Get file & dir names
intStart = LastInStr(strDirFile, "\")
strFoundInFolder = Left(strDirFile, intStart)

strFile = Mid$(strDirFile, intStart + 1)
'-- Write data to file
rstDetail.AddNew

rstDetail!FolderName = strFoundInFolder
rstDetail!FileName = strFile

rstDetail.Update



Next lngFiles
Else
MsgBox "No files were found in the directory.", vbInformation,
"File List"
End If
End With



FileinFolder_Exit:
On Error Resume Next
rst.Close
rstDetail.colse
Set dbs = Nothing
Exit Function

FileinFolder_Error:
MsgBox Err.Description, vbCritical, "File List Error"
Resume FileinFolder_Exit

End Function
Function LastInStr(strSearched As String, strSought As String) As Integer
Dim intCurrVal As Integer, intLastPosition As Integer

intCurrVal = InStr(strSearched, strSought)

Do Until intCurrVal = 0
intLastPosition = intCurrVal
intCurrVal = InStr(intLastPosition + 1, strSearched, strSought)
Loop

LastInStr = intLastPosition

End Function
Click to expand...
 
Hello Erin

what is it exactly you are trying to do. the reason i ask is that i used
only a small part of this code, if any.

i actually came up with code that will find me the folder for a specific
"product". the code is a lot simpler than this because i didnt need to store
the file/folder structures, just get the code to navigate to the proper
folder and then open it in windows explorer.

if you need to store the file/folder list then pursue this code, if you need
to just open a folder, then i can post my results.

to make this code posted here work, start a new module and just paste it in.

you will also need to make a table to store the results.

to use the code you will need an event that calls the function.

the function will automatically fill the table starting at the directory
that you specify in the strFolder (in the case posted it = "C:\" ). this code
then searches c:\ and all the subdirectories thereof and puts the list in the
table. ouch. that could take a while.

good luck!
 
Hi Dawn,

Folders get moved frequently over the network and ideally i would like to be
able to press a button on a form based on information of a project with a
specific project number. to show me where that folder actually sits
now....and then open the directory in windows explorer. so exactly what you
made it do. so i guess if i could see your code that would be great. the code
in this thread doesnt open it in windows explorer does it?
 
Hello Erin

i have some code to show you. This first part goes on your button in the on
click:

Private Sub cmdFolderFind_Click()
On Error GoTo Err_cmdFolderFind_Click

If IsNull(Me.Workorder) Then
Call fsFoldersearch(Me.cbProductTypeID, Left(Me.SerialNumber, 5),
Left(Me.SerialNumber, 5))
Else
Call fsFoldersearch(Me.cbProductTypeID, Left(Me.SerialNumber, 5),
Me.Workorder)
End If

Exit_cmdFolderFind_Click:
Exit Sub

Err_cmdFolderFind_Click:
MsgBox Err.DESCRIPTION
Resume Exit_cmdFolderFind_Click

End Sub

The second part is hefty and goes in a module:

Public Function fsFoldersearch(strProdType As String, strProductSerial As
String, strWorkOrderFolder As String)

Const strPathF As String = "P:\WO\"
Const strPathM As String = "\1 Completed\"
Const strPathDiv As String = "\"
Dim strFolder As String

'finding by workorder at begining of folder name in p drive workorder
product type folder
strFolder = Dir(strPathF & strProdType & strPathDiv & strWorkOrderFolder
& "*", vbDirectory)
If strFolder <> "" Then
MsgBox "The Product has not been completed.", vbOKOnly, "Not
Completed"
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " & Chr(34) & strPathF
& strProdType & strPathDiv & strFolder & Chr(34), vbNormalFocus
Else
'finding by workorder at begining of folder name in p drive
workorder product type completed folder
strFolder = Dir(strPathF & strProdType & strPathM &
strWorkOrderFolder & "*", vbDirectory)
If strFolder <> "" Then
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " & Chr(34) &
strPathF & strProdType & strPathM & strFolder & Chr(34), vbNormalFocus
Else
'finding by first five characters of serial number at begining
of folder name in p drive workorder product type folder
strFolder = Dir(strPathF & strProdType & strPathDiv &
strProductSerial & "*", vbDirectory)
If strFolder <> "" Then
MsgBox "The Product has not been completed.", vbOKOnly, "Not
Completed"
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " & Chr(34) &
strPathF & strProdType & strPathDiv & strFolder & Chr(34), vbNormalFocus
Else
'finding by first five characters of serial number at
begining of folder name in p drive workorder product type completed folder
strFolder = Dir(strPathF & strProdType & strPathM &
strProductSerial & "*", vbDirectory)
If strFolder <> "" Then
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " & Chr(34)
& strPathF & strProdType & strPathM & strFolder & Chr(34), vbNormalFocus
Else
'finding by Workorder anywhere in the folder name in p
drive work order product type folder
strFolder = Dir(strPathF & strProdType & strPathDiv &
"*" & strWorkOrderFolder & "*", vbDirectory)
If strFolder <> "" Then
MsgBox "The Product has not been completed.",
vbOKOnly, "Not Completed"
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " &
Chr(34) & strPathF & strProdType & strPathDiv & strFolder & Chr(34),
vbNormalFocus
Else
'finding by Workorder anywhere in the folder name in
p drive work order product type completed folder
strFolder = Dir(strPathF & strProdType & strPathM &
"*" & strWorkOrderFolder & "*", vbDirectory)
If strFolder <> "" Then
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " &
Chr(34) & strPathF & strProdType & strPathM & strFolder & Chr(34),
vbNormalFocus
Else
'finding by first five characters of serial
number anywhere in the folder name in p drive work order product type folder
strFolder = Dir(strPathF & strProdType &
strPathDiv & "*" & strProductSerial & "*", vbDirectory)
If strFolder <> "" Then
MsgBox "The Product has not been
completed.", vbOKOnly, "Not Completed"
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & "
" & Chr(34) & strPathF & strProdType & strPathDiv & strFolder & Chr(34),
vbNormalFocus
Else
'finding by first five characters of serial
number anywhere in the folder name in p drive work order product type
completed folder
strFolder = Dir(strPathF & strProdType &
strPathM & "*" & strProductSerial & "*", vbDirectory)
If strFolder <> "" Then
Shell Chr(34) & "EXPLORER.EXE" & Chr(34)
& " " & Chr(34) & strPathF & strProdType & strPathM & strFolder & Chr(34),
vbNormalFocus
Else
MsgBox "Folder does not exist",
vbOKOnly, "No Folder"
End If
End If
End If
End If
End If
End If
End If
End If
End Function

now that maybe over kill for you, but i had a few conditions to watch out
for. thing is it still doesnt work if someone doesnt follow the convention
when i set this up.

now here is the main part of the hefty code that you should look at
implementing your way:

Public Function fsFoldersearch(strProdType As String, strProductSerial As
String, strWorkOrderFolder As String)

Const strPathF As String = "P:\WO\"
Const strPathM As String = "\1 Completed\"
Const strPathDiv As String = "\"
Dim strFolder As String

'finding by workorder at begining of folder name in p drive workorder
product type folder
strFolder = Dir(strPathF & strProdType & strPathDiv & strWorkOrderFolder
& "*", vbDirectory)
If strFolder <> "" Then
MsgBox "The Product has not been completed.", vbOKOnly, "Not
Completed"
Shell Chr(34) & "EXPLORER.EXE" & Chr(34) & " " & Chr(34) & strPathF
& strProdType & strPathDiv & strFolder & Chr(34), vbNormalFocus
End If
End Function

notice that i have a "top" folder that i start in. as long as that is true
forever i dont have to worry about the variables at the top not working.

you will also notice i have 2 different kinds of products, completed and not
completed. this was something that made it that there were 2 places a product
could be. one other thing is the product type caused another set of
subfolders. so i could have 4 places to look depending on the product and the
completion. the completion was a function of production, had they finished
and shipped the product? the product type was either compressor or dispenser.
you situation might be different, you might need to just find the product
with in a "top" folder.

in my situation each natural gas compressor that we build is given a serial
number. in the folder that starts with the serial number there is all sorts
of information that anyone might need to see at anytime. this is why i built
this function in to the app that i created. on the main form they would be
"looking" at the database record and the button would grab the serial number
and use it to go find the folder for the product. a work order number is the
serial number of the compressor, hence the WO.

i think that you might need to think about how your products are stored, in
my case a work order folder was where the information about the product is
stored. if you are storing the information about the type of product, ie
wedges, then you may need to use the product number in the name of the folder
so that you have something unique to "find" with the code. this is probably
the biggest step in making this work. if there is nothing unique the code
will find the first one, open the folder and then stop. so if i had a folder
called "wood wedges" and "plastic wedges", and you gave the code "wedges" to
look for it would find the first folder, "plastic wedges" and open it, and
then stop.

i dont know what else to say... if you have any questions let me know here...

ttyl :)
 
Back
Top