Create folder


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
'**********************************************************************************************************
' Name:                 createFolder
' Author:               mielk | 2012-12-02
'
' Comment:              Function to create and return the reference to the specified folder.
'
' Parameters:
'   folderPath          The path of a folder to be returned.
'
' Returns:
'   Object              Object of a Scripting.Folder type representing a folder with the specified path.
'
'                       If the folder already exists, the function returns just the reference to it
'                       without taking any additional actions.
'
'                       If the folder doesn't exists, the function creates it and returns the reference
'                       to this folder.
'
'                       If the folder cannot be created (i.e. access is denied or the specified folderPath
'                       is incorrect) Nothing is returned.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02        mielk           Function created.
'**********************************************************************************************************
Public Function createFolder(folderPath As String) As Object
    Const METHOD_NAME As String = "createFolder"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object         '(Late binding that allows to use the function, even if
                                    'Microsoft Scripting Runtime library is not loaded)
    Dim strDriveName As String
    Dim strParentFolder As String
    '------------------------------------------------------------------------------------------------------


    'Create FileSystemObject instance if it hasn't been created yet. ------------------------------------|
    If objFSO Is Nothing Then                                                                           '|
        Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")                                     '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    With objFSO

        'If the given folder already exists, it is just assigned to the variable [createFolder] and -----|
        'returned as the result of the function.                                                        '|
        If .FolderExists(folderPath) Then                                                               '|
                                                                                                        '|
            Set createFolder = .getFolder(folderPath)                                                   '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Check if the drive from the given filepath exists. -------------------------------------|  '|
            strDriveName = .GetDriveName(folderPath)                                                '|  '|
            If .DriveExists(strDriveName) Then                                                      '|  '|
                                                                                                    '|  '|
                'Retrieve the parent folder name. -----------------------------------------------|  '|  '|
                strParentFolder = .GetParentFolderName(folderPath)                              '|  '|  '|
                If Not .FolderExists(strParentFolder) Then                                      '|  '|  '|
                    'If the parent folder of the base folder doesn't exist,                     '|  '|  '|
                    'the function is called recurrently to create it.                           '|  '|  '|
                    Call createFolder(strParentFolder)                                          '|  '|  '|
                End If                                                                          '|  '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                On Error Resume Next                                                            '|  '|  '|
                Call .createFolder(folderPath)                                                  '|  '|  '|
                Set createFolder = .getFolder(folderPath)                                       '|  '|  '|
                On Error GoTo 0                                                                 '|  '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
            End If                                                                                  '|  '|
            '-------- [If .DriveExists(strDriveName) Then] ------------------------------------------|  '|
                                                                                                        '|
        End If                                                                                          '|
        '------------ [If .FolderExists(folderPath) Then] -----------------------------------------------|


    End With


End Function