Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 357
  • Last Modified:

File Scripting Object: Creating a Folder dynamically

Hi EE,

The logic in the code window to create a folder works....

My question, is:

          if i take the code and make it one sentence, as below,
                  when the statement to create the path executes,
                          i get an error message: path not found,
                                    so that's why i broke up the code into 2 "phases"
                                              to check for the main path,
                                                         and then the subfolder path

does anyone know a way to test the whole path and create the whole path in one statment?
does anyone know why i had to break up the test/create into 2 "phases" in order for the
folder to create?

tx for your ideas and assistance, sandra

Dim fl                As Folder
Dim f                 As File
Dim fs                As Object

Set fs = CreateObject("Scripting.FileSystemObject")



pg_strFullPathTarget_PDF = pg_strShareServer & _
                           "\" & _
                           pg_strOutputFolder & _
                           "\" & _
                           "Elective_CourseNotifications_M1M2" & _
                           "\" & _
                           pg_strUserName & _
                           "\" & _
                           Format(Date, "YYYY-MM-DD") & _
                           "_" & _
                           "CourseInfo_pdf" & _
                           "\"


Debug.Print pg_strFullPathTarget_PDF
If Not fs.FolderExists(pg_strFullPathTarget_PDF) Then
       fs.CreateFolder (pg_strFullPathTarget_PDF)
       
             
Else
 
    ' Delete contents of pdf folder
        Set fl = fs.GetFolder(pg_strFullPathTarget_PDF)
        For Each f In fl.Files
            fs.DeleteFile (f)
        Next
       
End If


Dim fl                As Folder
Dim f                 As File
Dim fs                As Object

Set fs = CreateObject("Scripting.FileSystemObject")

pg_strFullPathTarget_PDF = pg_strShareServer & _
                           "\" & _
                           pg_strOutputFolder & _
                           "\" & _
                           "Elective_CourseNotifications_M1M2" & _
                           "\" & _
                           pg_strUserName


Debug.Print pg_strFullPathTarget_PDF
If Not fs.FolderExists(pg_strFullPathTarget_PDF) Then
       fs.CreateFolder (pg_strFullPathTarget_PDF)
End If


pg_strFullPathTarget_PDF = pg_strShareServer & _
                           "\" & _
                           pg_strOutputFolder & _
                           "\" & _
                           "Elective_CourseNotifications_M1M2" & _
                           "\" & _
                           pg_strUserName & _
                           "\" & _
                           Format(Date, "YYYY-MM-DD") & _
                           "_" & _
                           "CourseInfo_pdf" & _
                           "\"


Debug.Print pg_strFullPathTarget_PDF
If Not fs.FolderExists(pg_strFullPathTarget_PDF) Then
       fs.CreateFolder (pg_strFullPathTarget_PDF)
       
             
Else
 
    ' Delete contents of pdf folder
        Set fl = fs.GetFolder(pg_strFullPathTarget_PDF)
        For Each f In fl.Files
            fs.DeleteFile (f)
        Next
        
End If

Open in new window

0
mytfein
Asked:
mytfein
  • 7
  • 3
  • 2
3 Solutions
 
Rey Obrero (Capricorn1)Commented:
place this code in a Regular module

Option Compare Database
Option Explicit
Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Open in new window



now to create a folder, call the function

MakeSureDirectoryPathExists fullPath


fullPath .. the complete folder path  that ends in "\"

sample  fullPath="c:\f1\f2\f3\f4\f5\"

all the folders will be created automatically



0
 
mytfeinAuthor Commented:
Hi Cap,

tx for writing...

while i try this out, can u pls explain:

a) do i need to put a dll in the same folder as my mdb
    or is this dll naturally part of Access

b) this function is part of Access?
c) this function does 2 things?
     1) it test if folder exists
     2) if not, it creates it?

tx, pls advise, s
0
 
Chris BottomleyCommented:
Personally I use the following script in a normal code module ... can be any module but I tend to create one called library where they stay.
Call as

md pg_strFullPathTarget_PDF, true
to create the subfolders or

md pg_strFullPathTarget_PDF, false
to to test if the folder exists but not create it

mypath = md(pg_strFullPathTarget_PDF, false)
will assign the response to mypath string variable and if "" the folder does not exist, otherwise it will be the same as pg_strFullPathTarget_PDF

Chris
Function md(dosPath As String, Optional createFolders As Boolean) As String
Dim FSO As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
Dim bolret As Boolean
    
    md = ""
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not FSO.FolderExists(rootdir) Then
            Exit Function
        End If
 
        bolret = True
        For fldrIndex = 1 To UBound(fldrs) - 1
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not FSO.FolderExists(rootdir) Then
                If createFolders Then
                    FSO.createfolder rootdir
                Else
                    bolret = False
                End If
            End If
        Next
        If bolret Then
            For Each fldr In FSO.getfolder(rootdir).subfolders
                If Left(fldr.name, 2) = fldrs(UBound(fldrs)) Then
                    md = fldr.Path
                    Exit Function
                End If
            Next
        End If
        Exit Function
    End If
End Function

Open in new window

0
Prepare for your VMware VCP6-DCV exam.

Josh Coen and Jason Langer have prepared the latest edition of VCP study guide. Both authors have been working in the IT field for more than a decade, and both hold VMware certifications. This 163-page guide covers all 10 of the exam blueprint sections.

 
mytfeinAuthor Commented:
Hi Chris,

tx for writing...

does the code require the  path parameter to end in  \       ?

pls advise, tx, s
0
 
mytfeinAuthor Commented:
Hi,

so far i tested Cap's idea, and below is adaptation.....

     If Not fs.FolderExists(pg_strFullPathTarget_PDF) Then
       ' fs.CreateFolder (pg_strFullPathTarget_PDF)
       MakeSureDirectoryPathExists (pg_strFullPathTarget_PDF)
             
Else
 
    ' Delete contents of pdf folder
        Set fl = fs.GetFolder(pg_strFullPathTarget_PDF)
        For Each f In fl.Files
            fs.DeleteFile (f)
        Next
       
End If


           and it works....

Now, will go and test Chris's idea.... and will come back with feedback....
0
 
mytfeinAuthor Commented:
Hi Chris,

a) i put the function in a public module, and made the function: public function

b) then coded this:

    Dim strFunctionFileName As String
    strFunctionFileName = md(pg_strFullPathTarget_PDF, True)

c)  am getting compile error in the function for field:  fldr
       saying it's not defined
               i tried fso.fldr - got error msgs

       am using Access 2003.

tx, s
0
 
Rey Obrero (Capricorn1)Commented:
a) do i need to put a dll in the same folder as my mdb
    or is this dll naturally part of Access

NO dll needed, just place the function that i posted in a regular module

b) this function is part of Access?
this is a VB function that also works in VBA

c) this function does 2 things?
     1) it test if folder exists   >>> YES
     2) if not, it creates it?    >>>  YES

try it!!!
0
 
mytfeinAuthor Commented:
tx cap,

tried it... works...tx...
0
 
Chris BottomleyCommented:
Strange ... I dont know where I posted in error yet but I posted earlier!

You only need one solution ... but I found I had two versions of the MD function.  This one returns true or false as to directory found and I include it for completeness, usage otherwise (boolean return aside)is as said earlier.

Chris
Function md(dosPath As String, Optional createFolders As Boolean)
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
    
    md = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not fso.FolderExists(rootdir) Then
            md = False
            Exit Function
        End If

        For fldrIndex = 1 To UBound(fldrs)
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not fso.FolderExists(rootdir) Then
                If createFolders Then
                    fso.CreateFolder rootdir
                Else
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function

Open in new window

0
 
mytfeinAuthor Commented:
Hi Chris,

tx for the code...

a)if  i understand correctly, the function returns TRUE/FALSE  (if file exists) - pls confirm
b)if i understand correctly, we pass the function TRUE/FALSE - to control whether to create the
   file if it does not exist - pls confirm

c)if i understand correctly, the path name parameter should end in \

d) it seems the function to exit when it does not find the file, although passing in TRUE like this:

    Dim blnIfFileExists As Boolean
    blnIfFileExists = md(pg_strFullPathTarget, True)

pls see screen shot below, tx, s


2011-03-10-exit.GIF
0
 
Chris BottomleyCommented:
a. correct
b correct
c yes and no ... doesn't matter
d It is used to find/make a folder path not find a file which is as per the original question, i.e as agreed in B by design passing in true creates the filepath whereas false or omitted merely indicates presence of the file path.

Chris
0
 
mytfeinAuthor Commented:
Hi Chris,

a) i understand a-c, tx

b) yes, u r right, the object is to see if folder exists (not to see if file exists)
    so i changed the field name to:

Dim blnIfFolderExists As Boolean
blnIfFolderExists = md(pg_strFullPathTarget, True)

c) i figured out what the problem is:
     my path starts with a \\ bec. i am using the UNC way of pointing to a server location

    so i am passing a parm of:

            \\dean\share\registrar\aaa_Access_Registrar_Output\MailingLabels\gwashington\

    the first split in the function
           sets fldsrs(0)  to blank
          sets fldsrs(1)  to blank
           sets fldsrs(2)  to "dean"
          sets fldsrs(3)  to share

but the function tests for rootdir set by fldrs(0), since it's blank, function exits immediately.

If Not fso.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")

        Debug.Print fldrs(0)
        Debug.Print fldrs(1)
        Debug.Print fldrs(2)
        Debug.Print fldrs(3)

        rootdir = fldrs(0)
   
d) so i modified the code to allow for server name. function works now....

     i adapted your code, below in the code window, it's a little hardcoded bec if server is present
     i start the loop at bucket 5

     \\dean\share\regaffairs <--- this is the server
     \\dean\share\regaffairs\aaa_Access_Registrar_Output\MailingLabels\gwashington

              aaa_Access_Registrar_Output\MailingLabels\gwashington <---- these are folders

any comments would be appreciated, tx, s





Dim blnIfFolderExists As Boolean
blnIfFolderExists = md(pg_strFullPathTarget, _
                       pg_strShareServer, _
                       True)

'=============================

Public Function md(strDosPath As String, _
                   strRootDirectory As String, _
                   blnCreateFolders As Boolean)
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer

Dim intStartIndex As Integer
    
    md = True
    intStartIndex = 1
    
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(strDosPath) Then
        fldrs = Split(strDosPath, "\")

        Debug.Print fldrs(0)
        Debug.Print fldrs(1)
        Debug.Print fldrs(2)
        Debug.Print fldrs(3)

        rootdir = fldrs(0)
                        
        If Left(strRootDirectory, 2) = "\\" Then
           fldrs(0) = strRootDirectory
           rootdir = fldrs(0)
           intStartIndex = 5
        ElseIf Not fso.FolderExists(rootdir) Then
            md = False
            Exit Function
        End If

        For fldrIndex = intStartIndex To UBound(fldrs)
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not fso.FolderExists(rootdir) Then
                If blnCreateFolders = True Then
                    fso.CreateFolder rootdir
                    Debug.Print rootdir
                Else
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function

Open in new window

0

Featured Post

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

  • 7
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now