MkDir - Make Directory from string with several layers of folders (1 Viewer)

Status
Not open for further replies.

Rx_

Nothing In Moderation
Local time
Yesterday, 18:12
Joined
Oct 22, 2009
Messages
2,803
A subroutine that can create multiple level folders in one singe call.

mkDir call results with a Runtime error 76 "Path not found"
The MkDir can only create one additional folder to an existing directory.
e.g. C:\MyGoodness using MkDir it will fail trying to create C:\MyGoodness\YourGoodness\TheirGoodness

In this example, all files go to an X:\Reg\Database Reports folder
But, each user's report goes into a folder with that users's LanID plus into a folder with the specific Report Name. (a.k.a. Automatic filing system).
Each Report has the Report name + dateTime not shown here.

Problem: The first time a new user runs a report - the MkDir must make 2 folders at once.

To save time and space, the variable are not declared here.
Code:
ReportPathName ="Minority Report"   ' its an old movie and a new TV series
UserLogin = Environ("username") ' or use your favorite method
UserPath = ("X:\Reg\Database Reports\" & UserLogin & "\" & ReportPathName & "\")
strNewReportPath = UserPath ' redundant here but used in other code not shown
' Is there already a folder or does a new folder need to be created for the new user or the first time a report name is run.
DirName = strNewReportPath
    If Dir(DirName, vbDirectory) = "" Then
    If MsgBox("Is it OK to create a new folder in X:\Reg\Database Reports\" & UserLogin & "\" & ReportPathName & "? (recommended yes)", vbOKCancel) = vbOK Then
' If this was a first time user 2 directories  needs to be created for both the user and the report
  DirName = UserPath
  MakeDirectory DirName  'MkDir DirName will only add one \ at a time so use this public subroutine
  Err.Clear
Else
    MsgBox "Create new folder cancelled. Folder not created.", vbOKOnly, "Report Cancelled, must allow folder to be created - (feeling of total rejection)"
  Exit Function
End If
' ..... Continue with the report code ...
Here is the public Subroutine to create multiple folders with MkDir
Code:
Public Sub MakeDirectory(FolderPath As String)
On Error GoTo errTrap
Dim x, i As Integer
Dim strPath As String
x = Split(FolderPath, "\")

For i = 0 To UBound(x) - 1
    strPath = strPath & x(i) & "\"
    If Not FolderExists(strPath) Then MkDir strPath
Next i
Exit Sub
errTrap:
MsgBox "There was an error trying to make a New Directory", vbOKOnly +vbCritical, "Error In Process"
err.Raise 656 ' Use this custom error to raise to the caller for identification

End Sub
 
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom