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

SteveL13
SteveL13 used Ask the Experts™
on
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_Form_Load:
    Exit Sub

Err_Form_Load:
    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?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Distinguished Expert 2017
Commented:
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
    Else
        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
        Else
            FSO.CreateFolder (sRepPath)
        End If
        sRepPath = sRepPath & rs!RepID & "\"        'can only add one level at a time
        If FSO.FolderExists(sRepPath) Then
        Else
            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
        
        rs.MoveNext
    Loop

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

Error_Proc:

    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
    Resume

Open in new window

Most Valuable Expert 2015
Distinguished Expert 2018
Commented:
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:

CreatePath(Me!YourTextbox.Value)

Open in new window

/gustav

Author

Commented:
To all:  I am still working on this issue.
Should you be charging more for IT Services?

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Distinguished Expert 2017

Commented:
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.
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
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!

/gustav

Author

Commented:
I'm not sure how to award points to this topic.  If you are both correct please let me know.
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
Only you can tell. It's your problem we tried to solve.

/gustav
Distinguished Expert 2017

Commented:
Good answer Gus.  I stand corrected - you can't make two levels at once using Access or FSO methods.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial