Excel VBA folder-search-tool

[c_skytte]

Hi all,


Some time ago I've raised some questions here; in how to make a search-tool that looked for pdf-files in a specific folder on the server.
Result/status; it works!! ...but not without the superb help from all of you!


Now the main issue is that the search time seem too long for the users and therefore I'm thinking to resolve the "problem" in some other way.
Before we start, there are always some 'buts' to drag into the solution;
- I think to solve it by use of 2 files; one (in xlsm) as read only (as more users have to gain access at the same time) and the other one only controlling the data of the folder structure.
- I'd like to show it all in a userform.
- I have a search-textbox and 4 Listboxes looking at 4 different locations on the server LB1:PDF , LB2XF , LB3:STP , LB4WG.
- "live search-function" similar to this: https://www.youtube.com/watch?v=9PuVRE7ARKA in all listboxes


The files are all named in the same way (number of 5 digits + underscore + a version-letter), except the DWG-files, as they contain a 1- or a 2- in the beginning of the file so that a PDF/DXF/STP-file 77777_B.pdf would look different in DWG: 1-77777.dwg or 2-77777.dwg.

The problem is how to make the update of the file structure in each folder.
Should it be done by a "ActiveWorkbook.Connections refresh" and then update the read only-file afterwards?
I've made some tests of the speed on my C-drive. It took 14 seconds by updating 100000 files in 31000 folders... but there's not 100000 pdf-files in 30000 folders on the server: only 15000 in 20 folders.


All comments are welcome in how to make the connection refresh ...or if it should be in 2 files or only one?

Thanks,
C

[snb]

Please post the solution you use up till now.
I bet a lot can be improved to speed up the search process.

[c_skytte]

Hi snb,

The solution I've have until now? ...thats only the old solution ...the one with a looong search time.

The coding is VERY confusing...
To make it work you probably need to make some folders in a share called "H", containing these folders: H:\PDF , H:\DXF and H:\STEP.
in each folder you need folder 10, 20, 30, 40 and so forth.
The files needs to be "looking" like this: 55123_A.pdf or 71547_C.pdf.
...and of course 54578.pdf should be placed in folder 50 in the H:\PDF-folder.

note: errorhandlig isn't too good.

I've translated the most of the Userform and workbook with Google translate... hope it makes sense?

/c

[snb]

Try this to begin with:
In the Userform Macromodule:

Private Sub UserForm_Initialize()
  sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir H:\*.pdf  H:\*.dxf  H:\*.stp /b/s").StdOut.ReadAll, vbCrLf), ".")

  ListBox1.List = Filter(sn, ".pdf")
  ListBox2.List = Filter(sn, ".dxf")
  ListBox3.List = Filter(sn, ".stp")
End Sub

[c_skytte]

Hi snb,

Thanks! ...so far so good!

As the pdf, dxf, stp and DWG files already are "filtered" in different folders I've changed you code a bit:

  snDXF = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir H:\DXF\*.* /b/s").StdOut.ReadAll, vbCrLf), ".")
  snSTP = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir H:\STP\*.* /b/s").StdOut.ReadAll, vbCrLf), ".")
  snDWG = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir H:\DWG\*.* /b/s").StdOut.ReadAll, vbCrLf), ".")
  snPDF = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir H:\PDF\*.* /b/s").StdOut.ReadAll, vbCrLf), ".")
  
  ListBox1.List = Filter(snPDF, ".pdf")
  ListBox2.List = Filter(snDXF, ".dxf")
  ListBox3.List = Filter(snSTP, ".stp")
  ListBox4.List = Filter(snDWG, ".DWG")

But maybe it slows down the process to split it into 4 "Filter(Split(CreateObject"-functions?


Afterwards it makes a little complicated when i combine it with this code as it clears listbox1! :-(

Private Sub TextBox1_Change()
On Error Resume Next
If TextBox1.Text = "" Then
Me.ListBox1.Clear
Exit Sub
End If


'Me.ListBox1.Clear
    For r = snPDF To 99999999
    a = Len(Me.TextBox1.Text)
    If Left(snPDF.Value, a) = Me.TextBox1.Text Then
    With Me.ListBox1
    .AddItem snPDF.Value
    .List(.ListCount - 1, 1) = snPDF.Value
    End With
    End If
    Next
end sub

But it doesn't work ...it was something i stole from the video (video timestamp; 11:40) I added in the first post ...and tried to modify!

I wanted the listbox1 to 4 to remain blank, until a "search" was entered in textbox1.

To make it work as in the video, i need to implement the Filter(Split(CreateObject output to a sheet?? ....don't you think?

[snb]

This is faster; only creating 1 instance of "wscript.shell" and performing only 1 command.
Besides you can dim sn as a private variable, so you can use it in all code in the userform.
Then the Userform code can be reduced extraordinarily.
When starting the Userform with a presentation of 'default' files can improve the userfriendliness considerably.

Private Sub UserForm_Initialize()
  sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir H:\PDF\*.pdf  H:\DXF\*.dxf  H:\STP\*.stp H:\DWG\*.dwg /b/s").StdOut.ReadAll, vbCrLf), ".")

  ListBox1.List = Filter(sn, ".pdf")
  ListBox2.List = Filter(sn, ".dxf")
  ListBox3.List = Filter(sn, ".stp")
  Listbox4.List = filter(sn, ".dwg")
End Sub

When using .lIst to fill a listbox .clear doesn't make sense
https://www.snb-vba.eu/VBA_Fill_comb...istbox_en.html

[c_skytte]

Hi again,

Okay... I might try to dig into the "private variable" you are referring to.... but right now I ain't got a clue! 😉

When using .lIst to fill a listbox .clear doesn't make sense

Exactly 😊

But would it be possible to hide the populated content in the listbox by changing the textcolor to white until a value is typed in a textbox? ...if not, then it doesn't matter.

[snb]

I'd suggest a lot less code

[c_skytte]

I ain't got the time to test your idea today, but damn it looks good and simplified!

Thank you! ...finally I think I'm on the right track!

[c_skytte]

Hello again,


"on the right track" was a bit too drastic, so;


Is it possible to filter out (remove) the path from the files in the listbox? (so h:\DXF\12345.dxf --> 12345.dxf)


Is it possible to compare some typed figures in a textbox with the current listed items in the listbox and then only show the files containing these figures, starting from the left?
So by typing "111" will show the files 11111, 11112, 11188 and 11199.
(...I simply can't figure out how to do the link)

[c_skytte]

Once again I "forgot" to add some code in order to get some help from you guys.

Private Sub UserForm_Initialize()

    sn = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir H:\PDF\*.pdf H:\DXF\*.dxf H:\STEP\*.stp H:\autocad\*.dwg  /b /s").StdOut.ReadAll, vbCrLf), ".")
    
   LB_001.List = Filter(sn, ".pdf")
   LB_002.List = Filter(sn, ".dxf")
   LB_003.List = Filter(sn, ".stp")
   LB_004.List = Filter(sn, ".DWG")
      
  UserForm1.Show
  TextBox4.SetFocus
  
End Sub

So... the LB_001 now contains a lot of stuff


I'd like to isolate (only show) the files by typing a string in textbox4.
This search should be applied to LB_001, LB_002, LB_003 and LB_004, but I don't like to use the .removeItem-function, as I would like to be able to search some other file afterwards without running the DIR again,

sn = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir H:\PDF\*.pdf H:\DXF\*.dxf H:\STEP\*.stp H:\autocad\*.dwg  /b /s").StdOut.ReadAll, vbCrLf), ".")

My attempts;

Private Sub TextBox4_Change()
On Error Resume Next


'LB_001 = TextBox4.Text


'a = Len("*" & (Me.TextBox4.Text) & "*")
a = Len(Me.TextBox4.Text)


If Left(UserForm1.LB_001.Value, a) = UserForm1.Me.TextBox4.Text Then
With Me.LB_001
    .AddItem Me.LB_001.List
End With
End If
End Sub

But, couldn't make it work.


Second attempt;


I had an idea to not use the removeitem, but show searchstring result in Listbox8 by typing ... then nothing had to be removed from LB_001(or 2, 3 and 4).
Then I should just hide the LB_001 to 4 an only show Listbox8, 9, 10 and listbox11 (showing PDF, DXF, STP and DWG's)!

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
For i = LB_001.ListCount - 1 To 0 Step -1
    'If InStr(1, LB_001.List(i), TextBox4) = 0 Then LB_001.RemoveItem (i)
    If InStr(1, LB_001.List(i), TextBox4) = 0 Then ListBox8.AddItem (i)
    'If LB_001.List(i) = TextBox4 Then ListBox8.AddItem (i)
    
Next i
End Sub

But the main goal was; as by typing in TextBox4 the result shows by reducing the amount of files in LB_001, 2, 3 and 4.

But as any of you can see; any help is appreciated!

[snb]

In this code:

Private Sub UserForm_Initialize()
    sn = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir H:\PDF\*.pdf H:\DXF\*.dxf H:\STEP\*.stp H:\autocad\*.dwg  /b /s").StdOut.ReadAll, vbCrLf), ".")
    
   LB_001.List = Filter(sn, ".pdf")
   LB_002.List = Filter(sn, ".dxf")
   LB_003.List = Filter(sn, ".stp")
   LB_004.List = Filter(sn, ".DWG")
      
  UserForm1.Show
  TextBox4.SetFocus
  
End Sub

Delete the line Userofmr1.show, because this event will only run when Userform1.show has been executed elsewhere.
Delete the line Textbox4.Setfocus: you can arrange the taborder in Design Mode: Textbox4.Tabindex = 0

[c_skytte]

hi snb,

The Userform.Initialize-code contains a little more than that...
It is running a Userform2 as a kind of "database is updating"-sign

so the total bunch of code look like this:

Private Sub UserForm_Initialize()


    UserForm2.Show vbModeless
    Application.Wait (Now + TimeValue("0:00:01"))


    sn = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir H:\PDF\*.pdf H:\DXF\*.dxf H:\STEP\*.stp H:\autocad\*.dwg  /b /s").StdOut.ReadAll, vbCrLf), ".")
    'ORIGINAL GetFiles = Split(CreateObject("WScript.Shell").Exec("cmd /c dir """ & ParentFolder & """ /A-H-S /B /S").StdOut.ReadAll, vbNewLine)
    'sn = Split(CreateObject("WScript.Shell").Exec("cmd /c dir H:\PDF\*.pdf H:\DXF\*.dxf H:\STEP\*.stp H:\autocad\*.dwg /A-H-S /B /S").StdOut.ReadAll, vbNewLine)
    
   LB_001.List = Filter(sn, ".pdf")
   LB_002.List = Filter(sn, ".dxf")
   LB_003.List = Filter(sn, ".stp")
   LB_004.List = Filter(sn, ".DWG")
   
   Label18 = LB_001.ListCount
   Label18 = Format(Label18.Caption, "###,###")
   Label19 = LB_002.ListCount
   Label19 = Format(Label19.Caption, "###,###")
   Label20 = LB_003.ListCount
   Label20 = Format(Label20.Caption, "###,###")
   Label21 = LB_004.ListCount
   Label21 = Format(Label21.Caption, "###,###")
   
   UserForm2.Hide
  Label2 = Right(Now(), 8)
  UserForm1.Show
  TextBox4.SetFocus

the Application.Wait is added as Userfrom2 wasn't able to load the text "database is updating" before the DIR-function started, so it was left blank.
hope it makes sense :-)

I'll apply the Tabindex = 0 for TB4! ...Thanks!

(Any suggestion to solve the searchfunction? (maybe the DIR readout should/could be placed in some other sheet and then make the search there... or would that be an odd solution?))

[snb]

Label18 = LB_001.ListCount
Label18 = Format(Label18.Caption, "###,###")

Are you kidding ?
And why using 'format' ??

Label18 =LB_001.ListCount

It is running a Userform2 as a kind of "database is updating"-sign

Now I know why your program is so slow.
If you want to speed up your code you should refrain from running 2 Userforms.
Since we don't use a Dir method your database is complete after running the wscript.shell command. So Userfornm2 is 100% reduandant and unnecessarily deteriorating the speed.

[snb]

To search for a 5 character string see the code for TextBox T_001

[c_skytte]

Hi again,

Actually i'm pretty happy about the current speed compared with the previous version!

Yes or maybe mostly no... i'm not kidding, I thought it would be easier to read if a seperator was added in the listCount?

The reson for using UF2 was just a hince to the user that the database was updating by opening besides that i've added a re-update button which also loads UF2... and since this only takes between 2 and 3 seconds, I don't think the problem is that big. Previous in the old code, a search for just a single file took more than 8 seconds.

As you might have noticed I'm still a novice trying to put lines together to get somthing to work... but I know that by adding lots of nice to have functions doesn't make the code work faster.
I didnt knew it was a wscript.shell command, sorry ...

But I really appriciate all the help I can get and I'm blown back by the efford especially you are putting in this, thank you!

[c_skytte]

Didn't see your latest reply... i'll check it in the morning!
Thank you!

[snb]

When I look at it more closely I think you don't need several Listboxes.
As soon as the user has entered a 5 character string to look for we can put the result into 1 listbox.

[c_skytte]

Hi snb,

Thanks for the solution! ....it's superfast!

I've a question, would it be possible only to show the filename in LB_001 instead of filename incl. the path?

remove path - makes sorting easier.jpg

Then sorting of the listbox (the newest file first) would be a lot easier, by use of this code:

With LB_001
    For j = 0 To .ListCount - 2
        For I = 0 To .ListCount - 2
            If LCase(.List(I)) < LCase(.List(I + 1)) Then
                temp = .List(I)
                .List(I) = .List(I + 1)
                .List(I + 1) = temp
            End If
        Next I
    Next j
End With

It doesn't matter if the path is shown in the Buffer listbox (LB_005) ...as I guess it would make it easier to add to an mail later.

thanks :-)

[snb]

If you want to sort the files by date, use:

   sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir G:\OF\*.pdf G:\OF\*.dxf G:\OF\*.stp  G:\OF\*.dwg /b/s /o-d").StdOut.ReadAll, vbCrLf), ".")

If you want to refer to a file you need to use its fullname.
So I'd advise not to restrict the information to the filename only.
Or are you sure no 2 files in diffferent folders have the same name ?