Merge 2 pieces of code

[Steph]

Hi everyone. I have 2 separate pieces of code: 1 allows the user to browse
to and select a directory. The second opens all files within a flder
directory. In that piece, the folder path is predefined as a variable. I
would love to make that piece dynamic to allow for the user to browse to the
folder, read that folder as a variable, and apply it to the second piece of
code. The code is below. Thanks for your help!!

Get Directory Code:
Option Explicit
Public 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

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
_
As Long

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

Sub Test()
Dim Msg As String
Dim x As Variant
Msg = "Please select a location for the backup."
MsgBox GetDirectory(Msg)
End Sub

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function


Open Files Code:
Sub Open_all_files() 'Opens all files in folder AND Subfolders

Dim FSO As Scripting.FileSystemObject
Dim TopFolder As String
Set FSO = New Scripting.FileSystemObject
TopFolder = "C:\testfolder" '<<<<<<<<< THIS IS WHAT I WOULD LIKE
TO BE VARIABLE
InnerProc FSO.GetFolder(TopFolder), FSO

End Sub

Sub InnerProc(F As Scripting.Folder, FSO As Scripting.FileSystemObject)

Dim SubFolder As Scripting.Folder
Dim OneFile As Scripting.File
Dim WB As Workbook

For Each SubFolder In F.SubFolders
If LCase(SubFolder.Name) Like "*rollup*" Then
' do nothing
Else
InnerProc SubFolder, FSO
End If
Next SubFolder
For Each OneFile In F.Files
Debug.Print OneFile.path
If Right(OneFile.Name, 4) = ".xls" Then
Set WB = Workbooks.Open(Filename:=OneFile.path)
'Do stuff here
End If
Next OneFile

End Sub

 

[Tom Ogilvy]

As long as GetDirecotry is visible to this routine

Sub Open_all_files() 'Opens all files in folder AND Subfolders

Dim FSO As Scripting.FileSystemObject
Dim TopFolder As String
Set FSO = New Scripting.FileSystemObject
msg "Select directory"
TopFolder = GetDirectory(msg)
if TopFolder = "" then
msgbox "No selection, exiting"
exit sub
end if
InnerProc FSO.GetFolder(TopFolder), FSO

End Sub