Consulting

Results 1 to 7 of 7

Thread: Solved: Choose a folder in a directory if found.

  1. #1

    Solved: Choose a folder in a directory if found.

    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.

    [vba]
    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
    [/vba]

    Incorporate in this code

    [vba]


    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

    [/vba]
    Instead of selecting a folder, it will be prompt with InputBox to enter a folder name, then search and if found select.
    Thanks.
    Last edited by defcon_3; 06-04-2012 at 01:32 AM.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [VBA]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
    [/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    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:
    [vba]

    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

    [/vba]
    Function
    [vba]
    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

    [/vba]
    This also catch my interest but I dont understand much the code.

    [vba]
    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
    [/vba]
    Last edited by defcon_3; 06-04-2012 at 06:46 PM.

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    [vba]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[/vba]

  5. #5
    Thanks snb, just one more thing how can i do this?
    [vba]
    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.
    [/vba]

    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
    Last edited by defcon_3; 06-05-2012 at 06:41 PM.

  6. #6
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,646
    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:

    [vba] If ListBox1.Selected(1) Then msgbox ListBox1.List(1)
    [/vba]


    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.
    Last edited by snb; 06-06-2012 at 02:13 AM.

  7. #7
    Ok got it thanks snb ..

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •