Solved: Search directory and return values

[drawworkhome]

hi all,
this is my first post to the forum.
using code, i would like to have my workbook check a directory for subfolders. i would then like to pull some text and numbers out of the path to these folders. i would appreciate any ideas as to where to start. i would like this action to occur at work book open event.
i am using excel 2003 and 2007.

any ideas is greatly appreciated!:banghead:

[Zack Barresse]

Hi there, welcome to the board!

A search of our Knowledge Base results in some useful information. This entry does almost what you're looking for, and if not we can customize it any way you want...

http://www.vbaexpress.com/kb/getarticle.php?kb_id=829

So, that being said, what exactly are you looking to bring in? Is this a one-time macro? What is the directory you're going to be searching?

[GTO]

Greetings,

Let me echo Zack in welcoming you; I'm sure you'll you be glad you joined, as there's great folks here :-)

I did not tie this example to Workbook_Open, but see if this is headed in the right direction:

Option Explicit

Sub exa()
Dim strParentFolderPath As String
Dim ary As Variant
'// Change to suit //
strParentFolderPath = ThisWorkbook.Path & "\"

'// return an array of subfolder names from the //
'// called function. //
ary = SubDirectoryList(strParentFolderPath)

'// just to show names returned...
MsgBox Join(ary, ", ")
End Sub

Function SubDirectoryList(InitialFolder As String) As Variant()
Dim FSO As Object '<--- FileSystemObject
Dim fsoFolder As Object '<--- Folder
Dim fsoSubFolders As Object '<--- Folders
Dim aryNames As Variant

'// Set a reference to FileSystemObject //
Set FSO = CreateObject("Scripting.FileSystemObject")
'// Return the parent folder //
Set fsoFolder = FSO.GetFolder(InitialFolder)
'// Get the collection of subfoders //
Set fsoSubFolders = fsoFolder.SubFolders

'// Turn aryNames into an empty array so we can //
'// resize it as needed //
ReDim aryNames(0 To 0)

For Each fsoFolder In fsoSubFolders
'// Increase array size per loop and add folder //
'// names //
ReDim Preserve aryNames(1 To UBound(aryNames) + 1)
aryNames(UBound(aryNames)) = fsoFolder.Name
Next

'// Plunk our built array into the function's return value//
SubDirectoryList = aryNames
End Function


As to Zack's suggested link, uhmmm, the article seemed to be about combining workbooks?

Hope that helps,

Mark

[drawworkhome]

thank you both for the welcome!
erik

[lucas]

GTO, how about:
MsgBox Join(ary, vbCrLf)

[GTO]

@lucas:

Hi Brother,

That certainly returns a nicer looking msg, but to be honest, I was just supplying the msgbox as a visual - as I believe this is a preliminary step to the OP's goal of stripping some numbers/text from the path. So my thought (weak as those are sometimes :-) ) was to get some type of collection/array that we can strip from.

On a totally personal curiousness, it's November and I ain't been watchin' the news, how's the weather up there? If I could disregard the pollution (Phoenix metro area has gotten WAY too big), this is certainly a time when we get to brag a bit. Just barely beyond short-sleeves at night and great throughout the day.

Mark

[lucas]

I knew that Mark, I was just passing by.....

Weather here in Ok is still nice for this time of year. 70's day-50's nights.

It won't last though. Winter is right around the corner for us.

I may have to come South in January.......keep an eye out for an okie with a mattress strapped to the roof of his car, it might be me.

Cheers.

[drawworkhome]

i do plan on stripping integers and text from the file folders and then displaying in a listbox so the user can choose which file to work with. is there a proper procedure to post my workbook so others may review my work?

[drawworkhome]

:hi: hi all, thanks for responding to my query.
could someone explain the code to me in simpletons terms?
i can get thru most of it but the array part....??
erik

[lucas]

Yes, click on post reply at the lower left of the last post in the thread and after you post a message, scroll down and look for a button that says "manage attachments"

[drawworkhome]

thank you lucas.
i have attached my workbook for review. it is a work in progress from a newbie so, no choking on your coffee as you take a peek.

erik: pray2:

[drawworkhome]

here is the attachement.

[GTO]

Hi Erik,

You missed a step somewheres it appears. Below the quick reply msg box, click the 'Go Advanced' button, which will take you to a new window.

Below the larger reply box you will see an 'additional options' area, which has the manage attachments button. From there, its pretty self explanatory.

If the wb is over a meg or for multi attachments, you can attach in a zip.

I would mention that there's plenty of us (including yours truly) who do not have 2007, so you might want to post in .xls format.

In regards to your question, I hope this is on-track and of some help:

Presuming you were asking as to...

ReDim aryNames(0 To 0)

For Each fsoFolder In fsoSubFolders
'// Increase array size per loop and add folder //
'// names //
ReDim Preserve aryNames(1 To UBound(aryNames) + 1)
aryNames(UBound(aryNames)) = fsoFolder.Name
Next

The first bit changes aryNames to an array, albeit with only one empty element. This is but one way of doing it of course, but its one way of ending up with an array of values and not blank spots, so we'll be able to get stuff back from it later with ease.

The loop then (on the first run-thru) changes the array's base element's position to one, and UBound + 1 (since Ubound was zero) to one as well. So... in the first loop, we still only have one element (1 to 1), and in the following loops, we increase the upper boundary of our single-dimensional array to hold one more element (value) per loop.

Does that help at all?

Mark

Steve - Sorry and apologies, I thought you might have glanced through quickly. My bad sir.

Sounds like nice weather so far, but I'll be sure to watch for a mattress laden vehicle soon, beers on me :-)

[drawworkhome]

yes, your explaination does help. so much to learn!
i have since attached the workbook. any comments on the code is appreciated along with any suggestions on any books you might recommend for a newbie.
thank you for your help!
erik

[GTO]

Dang, I must have been typing even slower than my norm... anyways, in regards to...


i do plan on stripping integers and text from the file folders and then displaying in a listbox so the user can choose which file to work with...

...I am not understanding this part. If we are wanting to allow the user to select a file/workbook, why are we wanting to strip parts of the path to the wb?

Mark

PS - Sorry, but off for some shuteye for me. Will check bacl later.

[drawworkhome]

well, i am trying to do that because, umm, i want to learn how.
secondly, i just want to either display the numbers or text. have not decided which as of yet.

erik

[Zack Barresse]

As to Zack's suggested link, uhmmm, the article seemed to be about combining workbooks?
Mark, I linked to it to show the looping aspect, not necessarily the immediate action. Sorry for the confusion.

[drawworkhome]

zach, i appreciate any help/links!
erik

[GTO]

Hi Zack -

Shucks, its no doubt me just having a 'drain bamaged' day. Hope all is well/safe in fire-fighting :-)


Hey Erik,

Reference #14 and #16:

I'm afraid I'm at home and on my 'near death' laptop, so its a bit of a pain to recreate much. That and not having the other workbooks such as '8workingpo.xls', 'stevestracker.xls' and 'testpo1.xlsx' makes it tough (for me leastwise) to recreate and/or see what all is happening.

Those caveats aside and keeping in mind that I seem to be having an 'off' day, here are general observations. (PLEASE NOTE: If you try any changes, for goodness sakes, make them in a juck copy of your wb; as I don't want anything I suggest to goober up your project.)


You may wish to ditch the ThisWorkbook.Save residing in the below.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

'ThisWorkbook.Save

End Sub


If I am not totally 'off' today, calling the Save in BeforeSave is an unnecessary/non-productive recurse; as it forces the workbook to save twice ea time saved.


Sheets("po").[init].ClearContents
Sheets("po").Range("i18").Value = ""


When referring to ranges, I would refer to the range like: ...Range("A1") or ...Range(MyRange) for named ranges. IMHO, using Evaluate (or in this case, the shorthand notation for Evaluate, ie - the brackets) seems 'expensive'.

This is simply a minor suggestion and only my opinion, as of course using evaluate works. That said, my level of understanding (or lack thereof) prevents a very articulate observation, but in laymen terms, Evaluate seems to me to be like the girlfriend who always makes sure she's dressed 'just right' before heading out the door. This can be great when heading to a fancy party, but when just heading to the corner store, she still takes the same amount of time deciding what shoes would be best to wear even if we're just going to the corner convenience market for a quart of milk.

Not sure if that makes sense, and hopefully someone may explain it better, but in short - whenever Evaluate is used, it first has to decide whether to "dress" to go get/return an object, or just a value.

Again, if that's a bad explanation, hopefully Zack or Steve or someone else will catch/correct me.

Also - while probably not the best example from your code thus far, but as the above was taken from Workbook_Open, the following is as well.
You may wish to reduce/eliminate selecting/activating sheets/ranges in code. Most of the time, this is unnecessary.
Using (untested, so again, in a junk copy) Workbook_Open, take a look at the below.

Public Sub Workbook_Open()

'startpage.Show

If ThisWorkbook.Name = "8workingpo.xls" Then 'this is where u check to

If Sheets("polog").Range("b5") = "" Then
Call begininit
End If

'clear po sheet information
With ThisWorkbook.Worksheets("po")
.Range(poinfo).ClearContents
.Range(jobnum).Value = ""
.Range(jobname).Value = ""
.Range(vendor).Value = ""
.Range(datereqd).Value = ""
.Range(ponum).ClearContents
.Range(init).ClearContents
.Range("I18").Value = ""
.Range("a37:a40").Value = ""

'// If the "po" sheet actually needs to be the active sheet at this point, //
'// maybe: //
'Worksheets("po").Range("a1").Select
Application.Goto .Range("A1"), True
End With
Else
Exit Sub
End If
End Sub


Now specific to using a function to return the names of subfolders to a given directory(folder), you were calling the example sub procedure I included. We really want to call the function directly.

As you no doubt noted while testing your current (attached at #12) code, you ended up having the function add values twice to the listbox in the userform.
Again, not well tested, but in BeforeClose, try changing:

Public Sub Workbook_BeforeClose(Cancel As Boolean)
Call Module6.exa
'...etc


to:

Public Sub Workbook_BeforeClose(Cancel As Boolean)

startpage.Show

'...ext


Now in the userform 'startpage'. we can use the Initialize event to load our listbox by calling the function directly. Something like:

Private Sub UserForm_Initialize()

With Me
'.ListBox1.List = SubDirectoryList(ThisWorkbook.Path & "\")

'// Use the returned array from the function to load the list. //
.ListBox1.List = SubDirectoryList("C:\Documents and Settings\ERIK\Desktop\test po\")
With .ComboBox1
.RowSource = ""
.AddItem Worksheets("est").Range("a5").Value '"Aluminum"
.AddItem Worksheets("est").Range("a7").Value '"Glass"
.AddItem Worksheets("est").Range("a9").Value '"Sealant"
.AddItem Worksheets("est").Range("a11").Value '"Misc"
.AddItem Worksheets("est").Range("a13").Value '"Steel"
.AddItem Worksheets("est").Range("a15").Value '"Sub-Contract"
.AddItem Worksheets("est").Range("a17").Value '"Other"
.AddItem Worksheets("est").Range("a19").Value '"Shops"
.AddItem Worksheets("est").Range("a21").Value
.AddItem Worksheets("est").Range("a23").Value
.AddItem Worksheets("est").Range("a25").Value
.AddItem Worksheets("est").Range("a27").Value
.AddItem Worksheets("est").Range("a29").Value
.AddItem Worksheets("est").Range("a30").Value
.AddItem Worksheets("est").Range("a40").Value
.AddItem Worksheets("est").Range("a54").Value
End With
End With
End Sub


...where our function looks like:


Function SubDirectoryList(InitialFolder As String) As Variant()
Dim FSO As Object '<--- FileSystemObject
Dim fsoFolder As Object '<--- Folder
Dim fsoSubFolders As Object '<--- Folders
Dim aryNames As Variant
Dim i As Long
Dim strTemp As String

'// Set a reference to FileSystemObject //
Set FSO = CreateObject("Scripting.FileSystemObject")
'// Return the parent folder //
Set fsoFolder = FSO.GetFolder(InitialFolder)
'// Get the collection of subfoders //
Set fsoSubFolders = fsoFolder.subfolders

'// Turn aryNames into an empty array so we can //
'// resize it as needed //
ReDim aryNames(0 To 0)

strTemp = vbNullString

For Each fsoFolder In fsoSubFolders
'// Increase array size per loop and add folder //
'// names //

'// To use a VERY simple pattern and return only the numbers (no spaces, //
'// letters, etc) for each subfolder's name, we could use the Like operator.//
'// IF our pattern becomes more complex and/or there are a multitude of //
'// of subfolders, we may wish to look at using Regular Expressions. //
For i = 1 To Len(fsoFolder.Name)
'// See vba help topic and vba help topic example for Like operator. //
If Mid(fsoFolder.Name, i, 1) Like "[0-9]" Then
strTemp = strTemp & Mid(fsoFolder.Name, i, 1)
End If
Next

If Len(strTemp) Then
ReDim Preserve aryNames(1 To UBound(aryNames) + 1)
aryNames(UBound(aryNames)) = strTemp
strTemp = vbNullString
End If
'// BOO, HISS, GRUMBLE GRUMBLE... Not like this. We are wanting to return //
'// an array of values from the function, and use that array someplace. //
' Range("a1").Value = Right(fsoFolder.Name, 5)
' startpage.ListBox1.AddItem fsoFolder.Name
Next

'// Plunk our built array into the function's return value//
SubDirectoryList = aryNames
End Function


PLease note that for first testing purposes, the function could stay like at #3. In the above, I added a rudimentary way of returning only the numbers from the ea subfolder's name.

Well, this got a bit lengthy, but I hope some of it helps a bit,

Mark

[drawworkhome]

whoa! i think my right brain just locked up!
i really appreciate the effort you put into this! wow.
i will have to print this up and stumble my way thru it.
i agree with all comments you have. keep in mind that
when i started this, i was/am learning the syntax and structure of vba
and good coding practices....:dunno :help
with help from great people like yourself and others i hope to one day offer my help to others in this arena.

its never to late to teach an old dog new tricks.....

erik