asked on

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

ASKER CERTIFIED SOLUTION

Rey Obrero (Capricorn1)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mytfein

ASKER

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

Chris Bottomley

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

mytfein

ASKER

Hi Chris,

tx for writing...

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

pls advise, tx, s

mytfein

ASKER

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....

mytfein

ASKER

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

Rey Obrero (Capricorn1)

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

mytfein

ASKER

tx cap,

tried it... works...tx...

SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mytfein

ASKER

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

SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mytfein

ASKER

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