choose folder with restrictions

[coxonitus]

hi guys,
i'm still struggling with a problem so i'm posting a new thread.
look at the attachement so i hope i can make my point.

the dashboard will guide the users to their folders/workareas.
take"administratie".
if you click , enter pw. ( pw = jackson). then you will see 3 folders.
click "inkoop", then the excel file will show up. then open it to add data.

the problem is:
the user can only have acces to the folders as shown in the pop up. The user may not browse to other folders, otherwise the restriction has no purpose, i just can't get it fixed to direct the user only to the folders they have acces to. can anybody help me???

Another option that i would like is maybe to create a listbox. After entering correct PW, a listbox pops up, where the user enters the folder, but i don't how to fill the listbox with foldernames.

[Bob Phillips]

It needs a password to run it, and the VBA is password protected, so we can't look at anything.

[coxonitus]

sorry XLD,

now you see that i'm a absolute beginner.
all PW are jackson
don't ask me why, it just popped up

thnx

[Bob Phillips]

Sorry, you did say that in the original post, but I managed to miss it.

Now it errors on the path, I don't have such a path. What happens if it finds a correct path (so I can simulate it)?

[coxonitus]

xld
if it finds the path, it shows the windows explorer pop up, which shows me the 3 folders i want to work in.
normally that is ok, but it gives the user the chance to open that folder by using the windows explorer, and that is off limits.

it has to be a search mode restricted only to folders which have to show up in a pop up.

maybe if you choose your own path, put a folder in it and let it search, with the code i used, you'll get the idea

[Bob Phillips]

You could try this routine to display only the folders to pick from

[vba]

Public Function GetFolders(ByVal StartPath As String)
Const nPerColumn As Long = 38 'number of items per column
Const nWidth As Long = 13 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___FolderGoto" 'name of dialog sheet
Const kCaption As String = " Select folder"
'dialog caption

Dim i As Long
Dim TopPos As Long
Dim iFolder As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim cLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Dim FSO As Object
Dim fldr As Object

Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Function
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add
With thisDlg

.Name = sID
.Visible = xlSheetHidden
'sets variables for positioning on dialog
iFolder = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40

Set FSO = CreateObject("Scripting.FileSystemobject")
For Each fldr In FSO.GetFolder(StartPath).SubFolders

iFolder = iFolder + 1
If iFolder Mod nPerColumn = 1 Then

cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

cLetters = Len(fldr.Name)
If cLetters > cMaxLetters Then

cMaxLetters = cLetters
End If

.OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
.OptionButtons(iFolder).Text = fldr.Name
TopPos = TopPos + 13
Next fldr

.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24
CurrentSheet.activate
With .DialogFrame

.Height = Application.Max(68, _
Application.Min(iFolder, nPerColumn) * nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True
If .Show Then

For Each cb In thisDlg.OptionButtons

If cb.Value = xlOn Then

MsgBox cb.Caption
Exit For
End If
Next cb
Else

MsgBox "Nothing selected"
End If

Application.DisplayAlerts = False
.Delete
End With
End Function
[/vba]

[coxonitus]

XLD,
i want to try it, but it will not run.
What code do i need to put above your Public Function??

my sub starts with... sub Administratie ()

[coxonitus]

xld,
could you help me out here.
the function is not called in het module?
thnx

[mancubus]

try:

[VBA]
Sub test()
GetFolders ("C:\MyFolder\MySubFolder")
End Sub
[/VBA]

[coxonitus]

hey guys,

this works fine.
but when i choose the folder, it will not open the folder to choose the excel file.
any suggestions

[Bob Phillips]

I will knock something up, but refresh my memory first.

When you run say Administartie, do you want it to show just the files in the chosen directory, or do you want to show the subfoldes in that directory, and the files in the chosen subfolder?

[coxonitus]

i want to show the subfolders, and say i click a folder, it opens the excel file in that sub folder.

in the method you posted a message box pops up, with options.
when i click a subfolder, it does not open it but says me only it's name.
method is perfect, opening the sub en selecting the excel file in it is MAGIC

thnx

[GTO]

Hi All,

Did you try the wb at #23 in http://www.vbaexpress.com/forum/show...t=37155&page=2 ?

Sorry for the intrusion, but I am curious if it was problematic?

Thank you,

Mark

[Bob Phillips]

i want to show the subfolders, and say i click a folder, it opens the excel file in that sub folder.

Are you saying that each subfolder only has one Excel file in it, and will always have a file in it.

[coxonitus]

yes, exactly
de excel file is the data file, which a user can work in.

[coxonitus]

hi GTO,

i'm a beginner and that's really buggin me at the moment.
the first option you gave me was with a userform.
the code xld sent me is working but is not yet opening the files within the folder.
i have no experience with making a userform

thnx

[GTO]

Hi coxonitus,

Ahhh, no problem and certainly I encourage you to keep after it; the learning can be quite fun. Frustrating at times, but quite fun overall. I am interested in seeing XLD's solution of course, it was just making me too curious not to ask about the other. hope that's okay :-)

Mark

[Bob Phillips]

This is the Administratie procedure

[vba]

Sub Administratie()
'
' Administratie Macro

PW = InputBox("Geef het Paswoord aub !", , "*************")
If PW = "" Then Exit Sub
If PW <> "jackson" Then
MsgBox "Verkeerd Wachtwoord."
Exit Sub
End If

'Dim FolderName As String
' Dim Fld As Object
'Set Fld = CreateObject("Shell.Application").BrowseForFolder(0, "Select folder", 512, "C:\Documents and Settings\jschulpen\Bureaublad\projectberstanden\Office")
' If Not Fld Is Nothing Then
' FolderName = Fld.Self.path
' Call Shell("explorer.exe " & FolderName, vbNormalFocus)
' End If

Dim FPath As String
Dim FName As String
Dim wb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String
Dim FolderName As String

SaveDriveDir = CurDir

MyPath = "C:\test" '"C:\Documents and Settings\jschulpen\Bureaublad\projectberstanden\Office"

ChDrive MyPath
ChDir MyPath

FPath = SelectFolder(MyPath)
If FPath <> "" Then

FPath = MyPath & Application.PathSeparator & FPath & Application.PathSeparator
FName = Dir(FPath & "*.xls*")
If FName <> "" Then

Set wb = Workbooks.Open(FPath & FName)
End If
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub[/vba]

My amended folder list procedure

[vba]

Option Explicit

Public Function SelectFolder(ByVal StartPath As String) As String
Const nPerColumn As Long = 38 'number of items per column
Const nWidth As Long = 13 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___FolderGoto" 'name of dialog sheet
Const kCaption As String = " Select folder"
'dialog caption

Dim i As Long
Dim TopPos As Long
Dim iFolder As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim cLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Dim FSO As Object
Dim fldr As Object

Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Function
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add
With thisDlg

.Name = sID
.Visible = xlSheetHidden
'sets variables for positioning on dialog
iFolder = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40

Set FSO = CreateObject("Scripting.FileSystemobject")
For Each fldr In FSO.GetFolder(StartPath).SubFolders

iFolder = iFolder + 1
If iFolder Mod nPerColumn = 1 Then

cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

cLetters = Len(fldr.Name)
If cLetters > cMaxLetters Then

cMaxLetters = cLetters
End If

.OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
.OptionButtons(iFolder).Text = fldr.Name
TopPos = TopPos + 13
Next fldr

.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24
CurrentSheet.activate
With .DialogFrame

.Height = Application.Max(68, _
Application.Min(iFolder, nPerColumn) * nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True
If .Show Then

For Each cb In thisDlg.OptionButtons

If cb.Value = xlOn Then

SelectFolder = cb.Caption
Exit For
End If
Next cb
Else

MsgBox "Nothing selected"
SelectFolder = ""
End If

Application.DisplayAlerts = False
.Delete
End With
End Function[/vba]

[coxonitus]

XLD
what can i say, you really are the Lord!
I tested it out and it works absolutely perfect.
i would really like give a special thank you.

Hopefully you can help me more out, the next couple of lightyears.
like i told before, i'm a beginner so i was wondering if you could help me out with te codes you were using.
would you add some sentences so i could learn the procedure.
Only when you're having the time.

is the also a method with a userform to show results when you click an item.
let say, i type compressor.
when i call, it gives me all compressor which i have in my fleet?

thnx again

[Bob Phillips]

The SelectFolder procedure creates an old-style dialog, which has the controls dynamically added by using FSO to find all subfolders in the selected folder. The chosen option is returned as the function result. Nothing more complex than that.

I am not sure I understand the follow-up question.