PDA

View Full Version : Solved: select folder bij list



coxonitus
04-22-2011, 03:03 AM
hi everybody.

i will try to explain mij problem.
I'm working with 1 excel sheet... where buttons link me through to folders.
the sheet is used by several users, each with there one workspace.
if 1 users clicks a button, they have fill in a password, when password correct, there needs to come a list of folders where they can select the folder they need to work in.
In each folder there is an excel workfile.

Can somebody help me out, or is this not possible??

This is the code I'm using. it works fine but when the file list opens a can open underlying folders which is not what i want.

PW = InputBox("Geef het Paswoord aub !", , "*************")
If PW = "" Then Exit Sub
If PW <> "jackson" Then
MsgBox "Verkeerd Wachtwoord."
Exit Sub
End If
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Filename As Variant
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select File(s) to Open"
' Select Start Drive & Path
ChDrive ("C")
ChDir ("C:\Documents and Settings\jschulpen\Bureaublad\projectberstanden\Office")
With Application
' Set File Name Array to selected Files (allow multiple)
Filename = .GetOpenFilename(Fiter, FilterIndex, Title, , True)
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 0))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Not IsArray(Filename) Then
MsgBox "No file was selected."
Exit Sub
End If
' Open FilesFor
i = LBound(Filename)
msg = msg & Filename(i) & vbCrLf
' This can be removed
Workbooks.Open Filename(i)
MsgBox msg, vbInformation, "Files Opened" ' This can be removedEnd Sub

End Sub

Bob Phillips
04-22-2011, 03:15 AM
Sorry, I am not really sure what you want to happen. There is a bug in your code because you are not using Option Explicit, but I have no idea whether that fixes your problem.

Bob Phillips
04-22-2011, 03:32 AM
Just in case the code error is the problem, here is the fixed version



PW = InputBox("Geef het Paswoord aub !", , "*************")
If PW = "" Then Exit Sub
If PW <> "jackson" Then
MsgBox "Verkeerd Wachtwoord."
Exit Sub
End If
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim Filename As Variant
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
"Text Files (*.txt),*.txt," & _
"All Files (*.*),*.*"
' Default filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select File(s) to Open"
' Select Start Drive & Path
ChDrive ("C")
ChDir "C:\test" '("C:\Documents and Settings\jschulpen\Bureaublad\projectberstanden\Office")
With Application
' Set File Name Array to selected Files (allow multiple)
Filename = .GetOpenFilename(Filter, FilterIndex, Title, , True)
' Reset Start Drive/Path
ChDrive (Left(.DefaultFilePath, 0))
ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Not IsArray(Filename) Then
MsgBox "No file was selected."
Exit Sub
End If
' Open FilesFor
i = LBound(Filename)
msg = msg & Filename(i) & vbCrLf
' This can be removed
Workbooks.Open Filename(i)
MsgBox msg, vbInformation, "Files Opened" ' This can be removed

coxonitus
04-22-2011, 04:20 AM
XLSM file "press Button" after correct PW thenfolder 1folder 2 folder 3"open folder list " sub folder(s)Sub folder(s)Sub Folder(s)"choose Folder" xls file xls file xls file"choose list to work in"if users clicks button he is restricted to only choose options in this Folder ( for example see Yellow)all the other folders are "off Limit" for that person.

Bob Phillips
04-22-2011, 04:25 AM
Sorry mate, I am not trying to be awkward, but I really didn't understand your follow-up at all. Post it in Dutch and let me see if Google translate makes it clear for me, or even do that yourself.

coxonitus
04-22-2011, 04:42 AM
sorry,
i tried to upload an excel lay out.

Als ik deze code gebruikt zoals door jullie gepost krijg ik alle mappen die ik zoek te zien in het windows scherm.
Wat ik zoek is,
- klik button
- pop up scherm met alleen de windows mappen voor de betreffende gebruiker
-kies map
- dan open excel file.

ik zal een tekening maken en deze posten.
ik hoop dat je hier iets aan hebt

Bob Phillips
04-22-2011, 07:54 AM
This is what Google translate came up with,


If I use this code as posted by you I get all the folders I'm looking to see in the windows screen.
What I seek is
- click button
- pop up window with just the windows folder for the user
-choose map
- then open excel file.

I will draw pictures and posts.
I hope you have something to

Isn't that just great.

So, are you saying you want to restrict to just the folders that the initial drive selection shows, and not let them navigate up a level or whatever. If that is so, I think you will be out of luck.

coxonitus
04-22-2011, 08:42 AM
Yes, XLD,

this is what i mean, so securing the button with a pW has no purpose at all.
But is there no bypass, like MSO dialog, with restrictions, or the Shell application,
I'm not good at these things, so i lay my faith in you guys.

GTO
04-22-2011, 10:35 AM
Greetings coxonitus,

reference:

hi,
i'm looking through your posts and maybe one of you guys could help me out.

i wil try to explain mij problem.
i have a dashboard, when i click a button i have to give a password.
When password correct it has to open some sort of pop-up which gives me only the folders i want to choose, when i click a folder it opens the excel file.

in my case, when password correct it opens the pop-up in windows. that means it give's me the searcher of "C": drive. All i want is a local searcher or else the password i gave has no function.

someone??

...which you posted in: http://www.vbaexpress.com/forum/newreply.php?do=newreply&p=241652

I have to take off pretty quick, but I was wondering exactly what you meant in the bolded part.

For instance, let's say that the "pop up" initially started at (just by example) C:\MyData, and in C:\MyData\ there were three folders named: 'Folder 1', Folder 2' and 'Folder 3'. If I clicked on 'Folder 3', it won't open a workbook, it would open the folder. Does that make sense?

So what would we want to happen when one of the three folders is 'opened' or clicked?

coxonitus
04-22-2011, 10:50 AM
the users have only acces to the folder they have to work in, that's why i handed a password.

when the list of folders( for users only) opens, they can choose.
(sub Folder1) (sub Folder2)
if chosen sub folder 1 they open the excel file within to insert there work or whatever.
that's why i handed a password registration, or else it has no function, i have to direct the user to there own directory.

i'm sorry if the question is rather difficult but i have an example in Dutch if you want.

GTO
04-22-2011, 11:02 AM
Hi again,

Bob (XLD) is tons smarter than yours truly, but I wanted to see if its clarity that might be missing. I think attaching the workbook is a good idea, as maybe we can see better what you are trying to do.

That said, you have the vbproject password protected:dunno

You could list the password if not one you really use, or edit the last post and reload the attachment with out the password.

Mark

coxonitus
04-22-2011, 11:06 AM
u name i serve

thnx so far.

Bob Phillips
04-22-2011, 11:25 AM
This is my take on the situation.

If you want to direct them to a folder, directory, and then only allow them to pick from that folder or any sub-folders, you cannot use ANY of the file dialogs, as they will allow you navigate anywhere. The password in this sense is an irrelevance, as it controls what happens in your Excel code, but the file dialog is an system function.

If this is a correc t reading of the situation, I think you would have to build your own file dialog, maybe a treeview of all allowable files. This is maybe not easy for yourself with your current experience, but is not that hard for someone here who is more advanced with VBA.

Is this a correct assessment of what you want?

coxonitus
04-22-2011, 11:38 AM
XLD,

you are right, my experience is based on VBA forums. Sorry about that, but i think i'm learning fast.
to become a pro i thin it will take lightyears....

so if i'm not mistaken you meant it's fixable.

Could you help me out??

Bob Phillips
04-22-2011, 11:54 AM
I will see if I can knock something up over the next couple of days, so be patient. Hopefully someone else will jump in if they can deliver faster.

BrianMH
04-22-2011, 02:39 PM
Sub StopOtherDir()
Dim user As String
Dim allowedpath As String
Dim Path
Dim fd
user = Environ("username")

Select Case user
Case "Brian"
allowedpath = "C:\Users\Brian\Documents\"
Case "Rob"
allowedpath = "C:\Users\Brian\Documents\"
Case Else
MsgBox "please contact file creator to be added to the user list"
Exit Sub
End Select

Set fd = Application.FileDialog(msoFileDialogFilePicker)


Do
fd.InitialFileName = allowedpath
If fd.Show = -1 Then
Path = fd.SelectedItems(1)
Else
Path = "cancelled"
End If
Loop Until Path Like allowedpath & "*" Or Path = "cancelled"
End Sub


This seems easier. If the path is outside of the folder or its subfolders it loops back and directs the user back to their folder. It uses Environ to capture their username but you could change that bit to a password and change the select statement as appropriate.

coxonitus
04-25-2011, 11:05 PM
Brian,

It doesn't work.
It gives me immediatly the MsgBox "please contact file creator to be added to the user list

could you help me out here, for a new test

BrianMH
04-25-2011, 11:17 PM
You need to edit the case statement to show the appropriate usernames returned by Environ and edit the paths.

coxonitus
04-26-2011, 03:24 AM
Brian,

it works, ok.
But please look at the replies from XLD.
The problem i have is that the users have to ,only get acces to their own directory. That's not working now, because it browses througout "c".
I want to create a directory list, that gives me only those options i give them.

thnx anyway

Bob Phillips
04-26-2011, 05:28 AM
I didn't try the treeview option as Brian came up with an interesting idea, and I thought that might suffice. Would you like me try and knock that up?

coxonitus
04-26-2011, 05:32 AM
Hi XLD,
if it works the way we talked about why not.

please look at the code below. This code gives me also the options, but when i want to select it gives a failure with comment "Path does not excist or it's a folder"
could that be something?

Shell "C:\windows\explorer " & CreateObject("Shell.Application").BrowseForFolder(0, "Kies je Map", 512, "C:\Documents and Settings\jschulpen\Bureaublad\projectberstanden\Projecten"), 1

Bob Phillips
04-26-2011, 05:38 AM
That shows the folders okay, but how do you get the selected folder?

GTO
04-26-2011, 08:29 AM
Hi there,

For some reason, all the verbiage I typed disappeared, so this will be abbreviated/split.

Here's a try at a treeview that limits to the initial folder and one level down. As my only knowledge of treeviews is from a few examples I have run across, I imagine that it won't be as 'crisp' as possible, but seems to work :-)

In a Userform with one treeview:

Option Explicit
Dim FullFileName As String

Public Function InitializeForm(Layout, InitialPath As String)
Dim _
FTV As MSComctlLib.TreeView, _
TopNode As MSComctlLib.Node, _
SubNode As MSComctlLib.Node, _
FileNode As MSComctlLib.Node, _
ImgList As ImageList, _
FPARAMS As FILE_PARAMS, _
i As Long, _
ii As Long

'// Set a reference to the treeview //
Set FTV = Me.tvFolFilLister
'// Set a reference to a new ImageList and add some pics to it for our icons. I //
'// just plunked the pics into Image controls on a sheet. //
Set ImgList = New ImageList
With ImgList.ListImages
.Add Key:="FolOpen", Picture:=Sheet1.imgFolOpen.Picture
.Add Key:="FolClose", Picture:=Sheet1.imgFolClosed.Picture
.Add Key:="WBIcon", Picture:=Sheet1.imgWBIco.Picture
End With

Set FTV.ImageList = ImgList
FTV.Indentation = 14

FTV.Nodes.Clear

'// Add a node for our initial folder. //
Set TopNode = _
FTV.Nodes.Add(Key:=InitialPath, _
Text:=Replace(Mid(InitialPath, _
InStrRev(InitialPath, "\", Len(InitialPath) - 1) + 1 _
), _
"\", _
vbNullString), _
Image:="FolClose")

Me.Caption = "PLEASE WAIT...Collecting Files..."
Me.Repaint
DoEvents

'// Add nodes
For i = LBound(Layout, 2) To UBound(Layout, 2) - 1
'// Add folder nodes
Set SubNode = FTV.Nodes.Add(Relative:=TopNode, _
Key:=Layout(1, i) & Layout(2, i), _
Relationship:=tvwChild, _
Text:=Layout(2, i), _
Image:="FolClose")

For ii = LBound(Layout(3, i), 2) To UBound(Layout(3, i), 2)
If Not UBound(Layout(3, i), 2) = 0 Then
'// Add file nodes to folder nodes
Set FileNode = FTV.Nodes.Add(Relative:=SubNode, _
Key:=Layout(3, i)(1, ii) & Layout(3, i)(2, ii), _
Relationship:=tvwChild, _
Text:=Layout(3, i)(2, ii), _
Image:="WBIcon")
End If
Next
Next
'// Add file nodes to initial folder
For i = UBound(Layout, 2) To UBound(Layout, 2)
For ii = LBound(Layout(3, i), 2) To UBound(Layout(3, i), 2)
If Not UBound(Layout(3, i), 2) = 0 Then
Set FileNode = FTV.Nodes.Add(Relative:=TopNode, _
Key:=Layout(3, i)(1, ii) & Layout(3, i)(2, ii), _
Relationship:=tvwChild, _
Text:=Layout(3, i)(2, ii), _
Image:="WBIcon")
End If
Next
Next

If FTV.Nodes.Count Then
FTV.Nodes(1).Expanded = True
End If

Me.Caption = "Open File"
End Function

Private Sub tvFolFilLister_BeforeLabelEdit(Cancel As Integer)
Cancel = True
End Sub

Private Sub tvFolFilLister_Click()
Dim SelectedNode As MSComctlLib.Node

Set SelectedNode = Me.tvFolFilLister.SelectedItem
If SelectedNode Is Nothing Then Exit Sub

If IsFile(SelectedNode.Key) Then
FullFileName = SelectedNode.Key
Else
FullFileName = vbNullString
End If

Me.Caption = FullFileName
End Sub

Private Sub tvFolFilLister_Collapse(ByVal Node As MSComctlLib.Node)
Node.Image = "FolClose"
End Sub

Private Sub tvFolFilLister_DblClick()
Dim SelectedNode As MSComctlLib.Node

Set SelectedNode = Me.tvFolFilLister.SelectedItem
If SelectedNode Is Nothing Then Exit Sub

If IsFile(SelectedNode.Key) Then
FullFileName = SelectedNode.Key
Call MainProgram(FullFileName)
Unload Me
Else
FullFileName = vbNullString
End If
End Sub

Private Sub tvFolFilLister_Expand(ByVal Node As MSComctlLib.Node)
Node.Image = "FolOpen"
End Sub
Private Function IsFile(sFullName As String) As Boolean
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sFullName, WFD)

If Not hFile = INVALID_HANDLE_VALUE Then
If Not (WFD.dwFileAttributes And vbDirectory) = vbDirectory Then
IsFile = True
End If
End If

Call FindClose(hFile)
End Function

GTO
04-26-2011, 08:37 AM
2 of 3

In a Standard Module:

Option Explicit

'//*************************************************************************** **************//
'// Adapted From: //
'// -------------------------------------------------- //
'// Heap sort routine. //
'// Returns a sorted Index array for the Keys array. //
'// Author: Christian d'Heureuse (www.source-code.biz (http://www.source-code.biz/)) //
'// -------------------------------------------------- //
'// //
'// Notes: The original was designed for a 1-D array. I tacked in some stuff so that it //
'// would take a 2-D array and the row or column (in this case row) is picked to base the //
'// sort on. //
'//*************************************************************************** **************//

Function HeapSort2D_ByRow_Ascend(Keys, Row As Long)
Dim _
Base As Long, _
n As Long, _
i As Long, _
M As Long

Base = LBound(Keys, 2)
n = UBound(Keys, 2) - LBound(Keys, 2) + 1
ReDim Index(Base To Base + n - 1) As Long

For i = 0 To n - 1: Index(Base + i) = Base + i: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered heap
Heapify2D_ByRow_Ascending Keys, Row, Index, i, n
Next
For M = n To 2 Step -1
ExchangeM Index, 0, M - 1 ' move highest element to top
Heapify2D_ByRow_Ascending Keys, Row, Index, 0, M - 1
Next
HeapSort2D_ByRow_Ascend = Index
End Function

Private Sub Heapify2D_ByRow_Ascending(Keys, Row As Long, Index() As Long, _
ByVal i1 As Long, ByVal n As Long)
Dim _
Base As Long, _
nDiv2 As Long, _
i As Long

i = i1
Base = LBound(Index)
nDiv2 = n \ 2

Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If Keys(Row, Index(Base + k)) < Keys(Row, Index(Base + k + 1)) Then k = k + 1
End If
If Keys(Row, Index(Base + i)) >= Keys(Row, Index(Base + k)) Then Exit Do
ExchangeM Index, i, k
i = k
Loop
End Sub

Private Sub Heapify2D_ByRow_Descending(Keys, Row As Long, Index() As Long, _
ByVal i1 As Long, ByVal n As Long)
Dim _
Base As Long, _
nDiv2 As Long, _
i As Long

Base = LBound(Index)
nDiv2 = n \ 2
i = i1

Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If Keys(Row, Index(Base + k)) > Keys(Row, Index(Base + k + 1)) Then k = k + 1
End If
If Keys(Row, Index(Base + i)) <= Keys(Row, Index(Base + k)) Then Exit Do
ExchangeM Index, i, k
i = k
Loop
End Sub

Private Sub ExchangeM(a() As Long, ByVal i As Long, ByVal j As Long)
Dim Base As Long
Dim temp As Long

Base = LBound(a)
temp = a(Base + i)

a(Base + i) = a(Base + j)
a(Base + j) = temp
End Sub

GTO
04-26-2011, 08:38 AM
3 of 3

In a Standard Module:

Option Explicit

Public Const MAX_PATH As Long = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const ALL_FILES = "*.*"
Public Const vbDot = 46
Public Const vbBackslash = "\"

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Public Type FILE_PARAMS
bRecurse As Boolean
bFindOrExclude As Long
nCount As Long
nSearched As Long
sFileNameExt As String
sFileRoot As String
nSubLevel As Long
End Type

Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Public Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA _
) As Long

Public Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA _
) As Long

Public Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long

Public Declare Function PathMatchSpec Lib "shlwapi" _
Alias "PathMatchSpecW" (ByVal pszFileParam As Long, _
ByVal pszSpec As Long _
) As Long

Private fp As FILE_PARAMS

Sub AStart()
Call MAIN
End Sub

Function MAIN()
Dim _
aFolders As Variant, _
Keys As Variant, _
KeysTmp As Variant, _
Index As Variant, _
i As Long, ii As Long, x As Long, y As Long

'// Change to a Constant as shown below. I just made a variable due to flashdrive. //
'Dim INITIAL_FOLDER As String
'INITIAL_FOLDER = ThisWorkbook.Path & vbBackslash
Const INITIAL_FOLDER As String = "G:\2011\2011-04-19\test2\"

'// Ensure first folder exists, or bail here. //
If Not CreateObject("Scripting.FileSystemObject").FolderExists(INITIAL_FOLDER) Then
MsgBox "Houston, we have a problem...", vbInformation, vbNullString
Exit Function
End If

With fp
'// Pattern to match files to return. If non-excel, will need additional code //
'// and images to produce reasonable/correct icons //
.sFileNameExt = "*.xls"
.sFileRoot = INITIAL_FOLDER
End With
'// Initially shape/size our array. //
ReDim aFolders(1 To 3, 0 To 0)

Call InitialFolder_Search(fp.sFileRoot, aFolders)
Call Files_Search(fp.sFileRoot, aFolders)

For i = LBound(aFolders, 2) To UBound(aFolders, 2)
If Not UBound(aFolders(3, i), 2) = 0 Then
KeysTmp = aFolders(3, i)
ReDim Keys(LBound(KeysTmp, 1) To UBound(KeysTmp, 1), _
LBound(KeysTmp, 2) To UBound(KeysTmp, 2))
Index = HeapSort2D_ByRow_Ascend(KeysTmp, 2)
For x = LBound(Keys, 1) To UBound(Keys, 1)
For y = LBound(Keys, 2) To UBound(Keys, 2)
Keys(x, y) = KeysTmp(x, Index(y))
Next
Next
aFolders(3, i) = Keys
End If
Next

Load frmFilePicker
Call frmFilePicker.InitializeForm(aFolders, INITIAL_FOLDER)
frmFilePicker.Show

End Function

'// I wanted to try searching using API as well as the TreeView. I used several several//
'// examples for treeview from older files which I no longer recall sources. //
'// As to the API usage in this wb, I found nice examples at: //
'// http://allapi.mentalis.org/apilist/FindFirstFile.shtml //
'// as well as: //
'// Randy Birch's site: http://vbnet.mvps.org/ //
'// and... //
'// Karl E. Peterson's: ttp://vb.mvps.org/ //
Private Function InitialFolder_Search(sRoot As String, FolderLayout)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sRoot & ALL_FILES, WFD)

If Not hFile = INVALID_HANDLE_VALUE Then
Do
'// We of course start w/an initial folder, and we want just one level of //
'// subfolders. First we loop thru items (folders and files) in the initial//
'// folder, just grabbing the folders and disregarding the files. For ea //
'// folder, we search therein for files only. //
'// I'm not utterly sure, but it seems to me that FindNextFile does not grab//
'// any particular file; that is, it grabs files randomly like Dir(). Thus,//
'// I took some extra steps to ensure that the treeview lays out like a //
'// normal dialog (folders at top, files beneath). //
'// //
'// So... we loop thru everything in the initial folder: If it's a //
'// directory, but not those wacky dos ones with dots for name... //
If (WFD.dwFileAttributes And vbDirectory) _
And Not Asc(WFD.cFileName) = vbDot Then
'// ...make room in our array and ... //
ReDim Preserve FolderLayout(1 To 3, 1 To UBound(FolderLayout, 2) + 1)
'// ...add the path to the folder, //
FolderLayout(1, UBound(FolderLayout, 2)) = sRoot
'// include the folder's name, //
FolderLayout(2, UBound(FolderLayout, 2)) = TrimNull(WFD.cFileName)
'// and go get any files in this subfolder. //
Call Files_Search(FolderLayout(1, UBound(FolderLayout, 2)) & _
FolderLayout(2, UBound(FolderLayout, 2)), _
FolderLayout)
End If
Loop While FindNextFile(hFile, WFD)
End If
Call FindClose(hFile)
End Function

Private Function Files_Search(sRoot As String, FolderLayout)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim FileLayout
'// For the 3rd element in Folderlayout, we are going to add an array, FileLayout, //
'// which will hold ea file's path and name, to be used in the treeview's nodes. //
ReDim FileLayout(1 To 2, 0 To 0)

hFile = FindFirstFile(QualifyPath$(sRoot) & ALL_FILES, WFD)
If Not hFile = INVALID_HANDLE_VALUE Then
Do
'// Now we want to find just files. //
If Not (WFD.dwFileAttributes And vbDirectory) = vbDirectory Then
'// Make sure the file fits our pattern. //
If MatchSpec(WFD.cFileName, fp.sFileNameExt) Then
ReDim Preserve FileLayout(1 To 2, 1 To UBound(FileLayout, 2) + 1)
'// Path to file //
FileLayout(1, UBound(FileLayout, 2)) = QualifyPath$(sRoot)
'// Filename //
FileLayout(2, UBound(FileLayout, 2)) = TrimNull(WFD.cFileName)
End If
End If
Loop While FindNextFile(hFile, WFD)
'// Plunk our files' info into FolderLayout; a collection within a collection. //
FolderLayout(3, UBound(FolderLayout, 2)) = FileLayout
End If
Call FindClose(hFile)
End Function

Private Function QualifyPath(sPath As String) As String
If Right$(sPath, 1) <> vbBackslash Then
QualifyPath = sPath & vbBackslash
Else
QualifyPath = sPath
End If
End Function

Private Function TrimNull(startstr As String) As String
'// rid nulls, evidently faster than InStr
TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function

Private Function MatchSpec(sFile As String, sSpec As String) As Boolean
MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec))
End Function

Function FolExists(ByVal FilSysObj As FileSystemObject, ByVal FolderPath As String) As Boolean
FolExists = FilSysObj.FolderExists(FolderPath)
End Function

Function MainProgram(FullFilName As String)
Dim wb As Workbook

If Not FullFilName = ThisWorkbook.FullName Then
Set wb = Workbooks.Open(FullFilName)
MsgBox "Do stuff..."
End If
End Function

I hope this helps,

Mark

BrianMH
04-27-2011, 12:02 AM
Brian,

it works, ok.
But please look at the replies from XLD.
The problem i have is that the users have to ,only get acces to their own directory. That's not working now, because it browses througout "c".
I want to create a directory list, that gives me only those options i give them.

thnx anyway

Hope you found your solution. Btw I had read the replies and my code did allow them to "access" anywhere however if you put the paths in, it wouldn't allow them to select any file but in the path/subpath that you define as it would loop back and make them select again.

coxonitus
04-27-2011, 12:27 AM
Hi Guys,
This is what Ron de Bruin posted for me. This is what i was looking for.
The only work is filling the excact path,
the folder list that pops up, gives me the oppertunity to select en open the folder, and then open the excelfile.


Dim FolderName As String
Dim Fld As Object
Set Fld = CreateObject("Shell.Application").BrowseForFolder(0, "Select folder", 512, "C:\ xxx\xxx")
If Not Fld Is Nothing Then
FolderName = Fld.Self.path
Call Shell("explorer.exe " & FolderName, vbNormalFocus)
End If
End Sub

I want to thank you all for helping me, and i'm sure that i will post new threads.

thanx
coxonitus

This Thread is being solved

coxonitus
04-29-2011, 10:34 AM
xld
yes please.
i'm still learning

coxonitus
05-11-2011, 12:17 AM
hi GTO,

i look at your programms, i don't get it working.
i will try to explain again, using the following code

Private Sub zoekmap_Click()
Dim FName As Variant
Dim wb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String
Dim FolderName As String

SaveDriveDir = CurDir

MyPath = "C:\Documents and Settings\jschulpen\Bureaublad\projectberstanden\" 'this is the entire folder to look in

ChDrive MyPath
ChDir MyPath
'with the getOpenFilename i get to see a windows pop up, but i don't want that. i need a file search in a pop up that searches
'the Folder i want to look in, and then select any file i want.
FName = Application.GetOpenFilename(filefilter:="(*xlsx),*xlsx ") 'here i want all files in a folder which i can select
If FName <> False Then

'now i select a file and gives me the answer from the msg box

If Mid(FName, 1, InStrRev(FName, "\", , 1) - 1) <> MyPath Then
MsgBox "Sorry, je mag geen bestanden openen in deze map. Kies een bestand in deze map : " & MyPath
Else
Set wb = Workbooks.Open(FName)
End If
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir
Unload frmzoek
End Sub

i'm starting to get a little desperate.
thx