PDA

View Full Version : Solved: Choose a folder in a directory if found.



defcon_3
06-04-2012, 12:57 AM
Hi guys,

I want to make automation on a single directory which contains a lot of folder. Heres the scenario.

directory = contains a lot of folders.
folders = contains images.

What I wanted to do is to just enter the folder filename into inputbox and then the macro will search the entire directory and if the folder is found automatically it will be selected and load its content(images) filename to a listbox.

Any idea how will I search and select a folder?

After some research I got this code but I dont know how will I incorporate it with the below code.


Sub FindFiles()
Dim strDocPath As String
Dim strCurrentFile As String
Dim fname as Strinf

fname = InputBox ("Input Folder Name")
strDocPath = "c:\temp\"
strCurrentFile = Dir(strDocPath & fname)

Do While strCurrentFile <> ""
MsgBox strCurrentFile
strCurrentFile = Dir
Loop

End Sub


Incorporate in this code




Dim MyFolder As String
Dim MyFile As String

With Application.FileDialog(msoFileDialogFolderPicker)

If .Show = -1 Then

lstImages.Clear

txtDir.Text = .SelectedItems(1)
MyFile = Dir(.SelectedItems(1) & "\*.jpg")
Do While MyFile <> ""

lstImages.AddItem MyFile
MyFile = Dir
Loop
End If
End With


Instead of selecting a folder, it will be prompt with InputBox to enter a folder name, then search and if found select.
Thanks.

Bob Phillips
06-04-2012, 08:17 AM
Const strDocPath As String = "c:\temp\"
Dim fName As String
Dim MyFolder As String
Dim MyFile As String

fName = InputBox("Input Folder Name")
MyFolder = Dir(strDocPath & fName, vbDirectory)
If MyFolder <> "" Then

lstImages.Clear

txtDir.Text = MyFolder
MyFile = Dir(strDocPath & MyFolder & "\*.jpg")
Do While MyFile <> ""

lstImages.AddItem MyFile
MyFile = Dir
Loop
End If

defcon_3
06-04-2012, 06:19 PM
Thanks xld. It works however it only search on the main Dir and doesn't search thru sub folders, digging deeper the solution is a recursive searching using this one. I make it work but again I failed to incorporate.

Usage Example:


Dim colFiles As New Collection
RecursiveDir colFiles, "C:\Photos", "*.jpg", True

Dim vFile As Variant
For Each vFile In colFiles
Debug.Print vFile
Next vFile

Function

Public Function RecursiveDir(colFiles As Collection, _
strFolder As String, _
strFileSpec As String, _
bIncludeSubfolders As Boolean)

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colFiles.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop

'Call RecursiveDir for each subfolder in colFolders
For Each vFolderName In colFolders
Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
Next vFolderName
End If

End Function

Public Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
If Right(strFolder, 1) = "\" Then
TrailingSlash = strFolder
Else
TrailingSlash = strFolder & "\"
End If
End If
End Function

This also catch my interest but I dont understand much the code.


Sub Recurse_Dir(mypath As String, Why As String)
Dim DirList() As Variant
Dim counter As Integer
Dim MyName As String
counter = 0
ReDim DirList(1)

MyName = Dir(mypath, vbDirectory)

Do While MyName <> "" ' Start the loop.
If MyName <> "." And MyName <> ".." And InStr(1, MyName, "%") = 0 Then

If (GetAttr(mypath & MyName) And vbDirectory) = vbDirectory Then
ReDim Preserve DirList(counter)
DirList(counter) = mypath & MyName
counter = counter + 1

Else
If UCase(ActiveDocument.Name & ".rep") <> UCase(MyName) Then
If Why = "Report" Then
Call CheckTheFile(mypath, MyName)
Else
CheckUNV (mypath & MyName)
End If
End If
End If
End If
MyName = Dir ' Get next entry.
Loop
If counter = 0 Then Exit Sub
Call Recurse_Dir((DirList(counter)) & "\", Why)
Next

End Sub

snb
06-05-2012, 03:41 AM
sub snb()
c00= "G:\OF\" & InputBox("Input Folder Name")
if dir(c00,16)<>"" then lstimages.list= Split(CreateObject("wscript.shell").exec("cmd /c dir " & c00 & "*.jpg /b /s").StdOut.readall, vbCrLf)
end sub

defcon_3
06-05-2012, 06:12 PM
Thanks snb, just one more thing how can i do this?

txtDir.Text = .SelectedItems(1) 'where txtDir contains the path
MyFile = Dir(.SelectedItems(1) & "\*.jpg") 'and MyFile contains only the filenames of the images. So only filename are shown in the listbox.


I noticed as well that you have to run again the macro and when prompt cancel the inputbox and the macro will start searching otherwise if you just browse it you will have to wait and nothing will happen.
And the possibility to put indicator that the macro is still searching a folder..
Nevertheless its pretty good :)

snb
06-06-2012, 02:02 AM
If I understand you correctly:

Since you want all files in the folder and subfolders, it's imperative to have the fullname (path & name) of each file in the listbox.

To retrieve the selected item:

If ListBox1.Selected(1) Then msgbox ListBox1.List(1)



I don't quite get what you mean by this; so difficult to react upon.


I noticed as well that you have to run again the macro and when prompt cancel the inputbox and the macro will start searching otherwise if you just browse it you will have to wait and nothing will happen.

defcon_3
06-06-2012, 06:10 PM
Ok got it thanks snb :)..