How do I create Folders/Sub folders from User Form control button

  • Thread starter Thread starter Brian
  • Start date Start date
B

Brian

I have a User Form that I would like to take one of the spare control buttons
and have it set up my job folder on the hard drive.

I am not sure how to code it to achive the following results:


These are my text box ID's

Main Folder
 
If you can dig up a copy of the VBS documentation in a CHM file, it'll tell
you about the FileSystemObject, which lets you create files and folders and
do other cool stuff. You can use it in VBA as well as in VBScript, and it's
definitely what I would use for this. I think you can also find
documentation on it in MSDN.
 
How would I let the user select the drive to create the directory on? Ever
thing I see is for when you know the directory is on C: or D:, but what if
there are several drives for the user to choose from?

This what I have figured out so far. The .value are the values the user put
into the text boxes.

mkdir "\CES_No_1.value\CLLI_Code_1.value\TEO_No_1.value"
mkdir "\CES_No_1.value\CLLI_Code_1.value\TEO_No_1.value\Completed Drawings"
mkdir "\CES_No_1.value\CLLI_Code_1.value\TEO_No_1.value\Elec Job Folder"
mkdir "\CES_No_1.value\CLLI_Code_1.value\TEO_No_1.value\Misc Job Documents"
mkdir "\CES_No_1.value\CLLI_Code_1.value\TEO_No_1.value\Site Pictures"
 
Two comments. First, you mkdir lines are incorrect.
mkdir "\CES_No_1.value\CLLI_Code_1.value\TEO_No_1.value"

should be

mkdir "\CES_No_1.value\CLLI_Code_1.value\" & TEO_No_1.value

if TEO_No_1 is the name of the text box in which a value is entered.
As you wrote the code, the TEO_No_1.value is within the quotes that
that string, not the value of the text box, would be included in the
directory name.

Second. Below is some code that will allow you to prompt the user for
a drive. You'll need to set a reference to the scripting runtime. In
VBA, go to the Tools menu, choose References, and scroll down to and
check the item named "Microsoft Scripting Runtime".

Function GetDrive(LocalOnly As Boolean, _
FixedOnly As Boolean, _
FixedAndOptical As Boolean) As String
Dim FSO As Scripting.FileSystemObject
Dim DRV As Scripting.Drive
Dim DVs() As String
Dim M As Long
Dim N As Long
Dim S As String
Dim Include As Boolean

LocalOnly = False
FixedOnly = False
FixedAndOptical = True

Set FSO = New Scripting.FileSystemObject
ReDim DVs(1 To FSO.Drives.Count)
For Each DRV In FSO.Drives
Include = True
If LocalOnly = True Then
If DRV.DriveType = Remote Then
Include = False
End If
End If
If FixedOnly = True Then
If DRV.DriveType <> Fixed Then
Include = False
End If
End If
If FixedAndOptical = True Then
If DRV.DriveType <> Fixed And DRV.DriveType <> CDRom Then
Include = False
End If
End If
If Include = True Then
If DRV.IsReady = True Then
M = M + 1
DVs(M) = DRV.DriveLetter
S = S & vbCrLf & DRV.DriveLetter & " (" & DRV.VolumeName &
")"
End If
End If
Next DRV

ReDim Preserve DVs(1 To M)
S = UCase(Application.InputBox("Select A Drive" & S, _
"Select A Drive", , , , , , 2))
If S = vbNullString Then
GetDrive = vbNullString
Exit Function
Else
For M = LBound(DVs) To UBound(DVs)
If DVs(M) = S Then
GetDrive = DVs(M)
Exit Function
End If
Next M
End If
GetDrive = vbNullString

End Function


The parameter to this functions are:
LocalOnly If True, do not list remote, mapped drives
FixedOnly If True, list only hard drives, no optical
drives
FixedAndOptical If True, list both hard drives and optical
drivecs.

You an call this function with code like

Dim S As String
S = GetDrive(True, False, True)
If Len(S) > 0 Then
Debug.Print "selected drive: " & S
Else
Debug.Print "no selection"
End If


Cordially,
Chip Pearson
Microsoft Most Valuable Professional,
Excel, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
 
Back
Top