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
84
85
'**********************************************************************************************************
' Name: uniqueFolderName
' Author: mielk | 2012-12-02
'
' Comment: Function transforms the given folder name so that it is unique in its
' parent folder.
'
' Parameters:
' folderName The name of the folder to be transformed.
'
' Returns:
' String The specified folder name transformed into a unique one.
' If the parent folder doesn't containt the folder with such name, the original name
' is returned.
' If the folder with the specified name already exists in the parental folder, the
' number in brackets is appended to the given folder name.
'
' Example:
' ---------------------------------------------------------------------------------
' If you run the function for the folder name C:\folders\test and its parental
' folder (C:\folders\) doesn't contain any folder with this name, the original
' name (C:\folders\test) is returned.
'
' However, if the parental folder already contains a folder with this name, the name
' C:\folders\ test (1) is returned.
' In case this transformed name also exists already, the next number is appended:
' C:\folders\test (2), and so on.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02 mielk Function created.
'**********************************************************************************************************
Public Function uniqueFolderName(folderName As String) As String
Const METHOD_NAME As String = "uniqueFolderName"
'------------------------------------------------------------------------------------------------------
Static objFSO As Object '(Late binding that allows to use the function, even if
'Microsoft Scripting Runtime library is not loaded)
Dim strFolderName As String
Dim strParentFolder As String
Dim strTempName As String
Dim intCounter As Integer
'------------------------------------------------------------------------------------------------------
'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
'Checks if the folder already exists. -----------------------------------------------------------|
If .FolderExists(folderName) Then '|
'|
'If the given folder name already exists, function transforms its name by '|
'appending the number in brackets. '|
strParentFolder = .GetParentFolderName(folderName) '|
If Not VBA.right$(strParentFolder, 1) = "\" Then strParentFolder = strParentFolder & "\" '|
strFolderName = .GetBaseName(folderName) '|
'|
'------------------------------------------------------------------------------------| '|
Do '| '|
intCounter = intCounter + 1 '| '|
strTempName = strParentFolder & strFolderName & " (" & intCounter & ")" '| '|
Loop While .FolderExists(strTempName) '| '|
'------------------------------------------------------------------------------------| '|
'|
uniqueFolderName = strTempName '|
'|
Else '|
'|
'The given folder name is unique in the file system and is returned in its '|
'original form. '|
uniqueFolderName = folderName '|
'|
End If '|
'-------- [If .FolderExists(folderName) Then] ---------------------------------------------------|
End With
End Function