Solved

File Scripting Object:  Creating a Folder dynamically

Posted on 2011-03-09
12
330 Views
Last Modified: 2012-06-21
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
Comment
Question by:mytfein
  • 7
  • 3
  • 2
12 Comments
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 167 total points
ID: 35084577
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
 

Author Comment

by:mytfein
ID: 35084651
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35084678
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
 

Author Comment

by:mytfein
ID: 35084820
Hi Chris,

tx for writing...

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

pls advise, tx, s
0
 

Author Comment

by:mytfein
ID: 35085147
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
 

Author Comment

by:mytfein
ID: 35085277
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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 119

Expert Comment

by:Rey Obrero
ID: 35085763
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
 

Author Comment

by:mytfein
ID: 35085808
tx cap,

tried it... works...tx...
0
 
LVL 59

Assisted Solution

by:Chris Bottomley
Chris Bottomley earned 333 total points
ID: 35086179
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
 

Author Comment

by:mytfein
ID: 35086832
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
 
LVL 59

Assisted Solution

by:Chris Bottomley
Chris Bottomley earned 333 total points
ID: 35086950
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
 

Author Comment

by:mytfein
ID: 35088146
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

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Join & Write a Comment

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now