passing a value to another function

[Rob]

Hey folks,

I'm a little rusty with my VBA...

I created a few lines of code that will allow me to insert the names of each
directory and all of the files from each directory to a word document. I
will eventually pass the same info into an excel sheet. Eventually, I may
find a need to create a hyperlink to each folder/file but that is way down
the line. I did it once in JAVA, but lost the code years ago due to
non-use. I also hate JAVA, but thats not the issue here.

My code works perfectly, but I added a full path (i.e "C:\Temp") to my
fuction call.

What I want to do is allow the user to pick the directories to copy using
(what I think is called) a windows common dialog box.

Once I select the folder I wish to start in, I want to pass the full path to
my function call (in a string variable)

I tried this with with the filedialog property, but you cannot pick a folder
(you must pick a file)

Any ideas?

 

[Rob van Gelder]

Chip Pearson has a Browse for Folder example on his website.
http://www.cpearson.com/excel/BrowseFolder.htm

 

[Bob Phillips]

Hi Rob,

Want this?

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long


Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

arfiles = Array()
cnt = -1
level = 1

sFolder = GetFolder
If sFolder <> "" Then
ReDim arfiles(1, 0)
SelectFiles sFolder
If SheetExists("Files") Then
Worksheets("Files").Cells.ClearContents
Else
Worksheets.Add.Name = "Files"
End If
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(1,
i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(0, i)
Next
.Columns("A:Z").EntireColumn.AutoFit
End With
End If

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

If sPath = "" Then
Set FSO = CreateObject("SCripting.FileSystemObject")
sPath = "c:\myTest"
End If

Set Folder = FSO.GetFolder(sPath)

Set Files = Folder.Files
For Each file In Files
cnt = cnt + 1
ReDim Preserve arfiles(1, cnt)
arfiles(0, cnt) = Folder.path & "\" & file.Name
arfiles(1, cnt) = level
Next file

level = level + 1
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next

End Sub

'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function

'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name)
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

If IsMissing(Name) Then Name = "Select a folder."
bInfo.pidlRoot = 0& 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function






--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Rob]

Thanks, Ill give it a try... looks like you saved me a bunch of reading

 

[Rob]

Thanks, I'll give it a try; I do appreciate the help

Rob

 

[Rob]

My messages do not appear to be posting; I'll try again...

Thanks to both RVG and RP for the help!

I don't have much experience with VB/VBA Windows API calls or, shell calls.
I'd like to learn more about subject; any book or website suggestions ?

Thanks again for your assistance!

Rob F

 

[Bob Phillips]

We saw your messages on the NG using a news server Rob.

I would suggest Power Programming with VBA by John Walkenbach, or the Excel
VBA 2002 Programmer's Reference by John Green, Stephen Bullen & Rob Bovey
(avoid the 2003 edition). Go to your local bookstore and flick through and
see which one suits.

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Rob van Gelder]

For websites, go to Google and type:
related:www.vangelder.co.nz/excel