How create a folder on a server with the PK as the folder name

I have a main form (the first form that opens with this onload event:

Private Sub Form_Load()
On Error GoTo Err_Form_Load

    Dim strAttachmentDirectory As String
    strAttachmentDirectory = DLookup("AttachmentDirectory", "LOCALtblDatabaseSetup")
    If Not Right(strAttachmentDirectory, 1) = "\" Then strAttachmentDirectory = strAttachmentDirectory & "\"
    TempVars!strAttachmentDirectory = strAttachmentDirectory

    Exit Sub

    MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf & "Error Source: " & Err.Source
    Resume Exit_Form_Load
End Sub

Which I believe is establishing the name of the folder I want on the C: drive.

But then within that established folder I want another folder to be setup using the PK on another form when a command button is clicked AND have an explorer window open to that newly established folder.  So there will end up being separate folders for each PK.  

If the folder was already setup by a previous onclick event I want the explorer window to open to it.

How can I do this?
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Here;s a code snippet that should get you started.  I would not make a directory until I actually had to write something to it.  That's what this code does.  It produces a batch of reports and for each report determines if the necessary folder exists.  I had a two level problem.  I might have a new call center or a new rep within the call center so I had to deal with call center first and then repID.

Since this code uses the FSO (File System Object), it REQUIRES a reference to Microsoft Scripting Runtime.  Open any code module and press Tools/References.  Navigate to the library and select it.

'''requires a reference to Microsoft Scripting Runtime   

    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim td As DAO.TableDef
    Dim sPath As String
    Dim sRepPath
    Dim sDate As String
    Dim RecCount As Long
    Dim sFileName As String
    Dim FSO As New FileSystemObject
    DoCmd.RunMacro "mWarningsOff"    
    sDate = Format(Date, "yyyymmdd")
    If Right(Me.txtPath, 1) = "\" Then
        sPath = Me.txtPath
        sPath = Me.txtPath & "\"
    End If
   On Error GoTo Error_Proc

    Set db = CurrentDb
    Set qd = db.QueryDefs!qUniqueReps
        qd.Parameters("[forms]![MainForm]![cboProductionID]") = Me.cboProductionID             ' "[forms]![MainForm]![cboProductionID]"
        qd.Parameters("[forms]![MainForm]![txtFromDT]") = Me.txtFromDT                   ' "[forms]![MainForm]![txtFromDT]"
    Set rs = qd.OpenRecordset

    Me.txtWhichRpt = "PDF"

     Do Until rs.EOF
        Me.txtRepID = rs!RepID
        Call BuildSQL
        sRepPath = sPath & rs!CallCenterCode & "\"  'can only add one level at a time
        If FSO.FolderExists(sRepPath) Then
            FSO.CreateFolder (sRepPath)
        End If
        sRepPath = sRepPath & rs!RepID & "\"        'can only add one level at a time
        If FSO.FolderExists(sRepPath) Then
            FSO.CreateFolder (sRepPath)
        End If
        sFileName = sRepPath & Format(Date, "yyyymmdd") & "_" & sDate & "_" & "BlueRpt_" & rs!CallCenterCode & "_" & rs!RepID & "_" & rs!Rep & ".pdf"
        DoCmd.OutputTo acOutputReport, "rptProfile", acFormatPDF, sFileName, False
        sFileName = sPath & Format(Date, "yyyymmdd") & "_" & sDate & "_" & "BlueRpt_" & rs!CallCenterCode & "_" & rs!RepID & "_" & rs!Rep & ".pdf"
        DoCmd.OutputTo acOutputReport, "rptProfile", acFormatPDF, sFileName, False

   On Error GoTo 0
   Set FSO = Nothing
   DoCmd.RunMacro "mWarningsOn"
   Exit Sub


    Select Case Err.Number
        Case 2501
            Resume Next
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdBlueRptPDF_Click of VBA Document Form_MainForm"
    End Select
    Resume Exit_Proc

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Gustav BrockCIOCommented:
There is a simple and direct call for this.
Copy/paste into a new module:

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Public Sub CreatePath(ByVal Path As String)
    If Right(Path, 1) <> "\" Then
        Path = Path & "\"
    End If
    MakeSureDirectoryPathExists Path
End Sub

Open in new window

Then call:


Open in new window

SteveL13Author Commented:
To all:  I am still working on this issue.
The 7 Worst Nightmares of a Sysadmin

Fear not! To defend your business’ IT systems we’re going to shine a light on the seven most sinister terrors that haunt sysadmins. That way you can be sure there’s nothing in your stack waiting to go bump in the night.

I answered the question.  I posted code that shows how to add two levels of directories.  They must be done one at a time.  You can't make two levels at once.
Gustav BrockCIOCommented:
You can't make two levels at once.

Be careful with definitive statements.
Please call my nice little function, and enjoy this beautiful day as one of those where:
Today I learnt something new!

SteveL13Author Commented:
I'm not sure how to award points to this topic.  If you are both correct please let me know.
Gustav BrockCIOCommented:
Only you can tell. It's your problem we tried to solve.

Good answer Gus.  I stand corrected - you can't make two levels at once using Access or FSO methods.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.