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



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

[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:


Sub test()
GetFolders ("C:\MyFolder\MySubFolder")
End Sub

[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/showthread.php?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



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

My amended folder list procedure



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

[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.

[coxonitus]

hi XLD,
this is why.
Programm runs great, final touch is protecting when to start this programm.

Problem is:
when i start up test, it show immediateley a UF1.(code in This Workbook)
If you username is ok, next UF2 starts to conform.
Then open programm.

UF1 is a template that will run en check if username excists, if not application quit. if username correct then goto UF 2.

please look a my attachement, i don't know why it won't run.

[Bob Phillips]

What is supposed to happen. The form pops up with my username in it, but there is no code behind it to process it. Where should it check the username against, what should it do if ok, what if not ok?

[coxonitus]

in the module2. sub form, it should check if username excists. if yes UF2 has to show, click ok en the program is open to use. if not UF3 says "not recognised, application quit.

did i told enough?

[Bob Phillips]

Not for me I am afraid. Check the user exists where? The user clearly exists because you get it from Application Username (btw, I would use the login name, not the Excel username), but where should it be checked against?

[coxonitus]

hi xld,
i thought i was doing fine but now i'm confused.
i'm gonna create an excel sheet with usernames on it, so the programm checks if this user is certified to open the programm

is that an option??
so when the user excists it will open the programm if not Application quit.

would that work?

[Bob Phillips]

That would/should work, but you should very hide the sheet so that users don't see the allowable user ids.

[coxonitus]

i have some of it working, but could you help me out here.
the UF shows up and sees that the user is active and the application starts.
can you help me out how to enter more usernames,
the text in the UF is protected, but how do i make it work to let the user fill their own name,
and then the macro wil start

[Bob Phillips]

Post the latest workbook.

[coxonitus]

hereby.

when "start" uF pops up.
question. User must type their own name, when ok uf 2 pops up "Welcome etc"when incorrect, Application Quit.

question 2,
how to give up extra usernames??

[Bob Phillips]

No attachment.

[coxonitus]

attachement!

[Bob Phillips]

You said you had some of it working. I cannot see anything more than the last version.

[coxonitus]

with text

[coxonitus]

hi XLD,

sorry for interrupting, but i have it working.
i will sent an attachement so you can see how i made it work. i did not change the procedure, i think this is safer.

maybe i can ask you to help me out again.
the vba code you have written for me for restricted file&folder searching, works perfect but i was wondering, like you told me before.
can you make the code that if there are more excel files in the folder the user can select which excel file to choose??

thanx a lot.
if you give me your private adress i will sent you the complete dashboard so you can see why i had to make it like this.