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
86
87
88
89
90
'**********************************************************************************************************
' Name: uniqueFilePath
' Author: mielk | 2012-12-02
'
' Comment: Function transforms the given filepath so that it is unique in the file system.
'
' Parameters:
' filepath The filepath to be transformed.
'
' Returns:
' String The specified filepath transformed into a unique one.
' If the specified filepath doesn't exist yet, the original name is returned.
' If the file with the specified path already exist, the path returned by the
' function consists of the original filepath and the number in brackets appended
' after the filename.
'
' Example:
' ---------------------------------------------------------------------------------
' If you run this function for filepath C:\test.txt and such file doesn't exist
' yet, the original filepath (C:\test.txt) is returned.
'
' However, if such file already exists, the filepath C:\test (1).txt is returned.
' In case this transformed filepath also exists already, the next number is appended:
' C:\test (2).txt and so on.
'
'
' Please note that the function doesn't check if the given filepath has been
' constructed properly. If the function is invoked with the improper filepath, it is
' just trying to find this file in the file system, but won't find it, since the
' filepath is improper, and will think about it as if it was a unique filepath.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02 mielk Function created.
'**********************************************************************************************************
Public Function uniqueFilePath(filepath As String) As String
Const METHOD_NAME As String = "uniqueFilePath"
'------------------------------------------------------------------------------------------------------
Static objFSO As Object '(Late binding that allows to use the function, even if
'Microsoft Scripting Runtime library is not loaded)
Dim strFileExtension As String
Dim strFileName As String
Dim strParentFolder As String
Dim strTempFilePath 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 file already exists. -------------------------------------------------------------|
If .fileExists(filepath) Then '|
'|
'If the given filepath already exists, function transforms its name by '|
'appending the number in brackets. '|
strParentFolder = .GetParentFolderName(filepath) '|
If Not VBA.right$(strParentFolder, 1) = "\" Then strParentFolder = strParentFolder & "\" '|
strFileName = .GetBaseName(filepath) '|
strFileExtension = "." & .GetExtensionName(filepath) '|
'|
'------------------------------------------------------------------------------------| '|
Do '| '|
intCounter = intCounter + 1 '| '|
strTempFilePath = strParentFolder & strFileName & _
" (" & intCounter & ")" & strFileExtension '| '|
Loop While .fileExists(strTempFilePath) '| '|
'------------------------------------------------------------------------------------| '|
'|
uniqueFilePath = strTempFilePath '|
'|
Else '|
'|
'Specified filepath is unique in the file system and is returned in its original form. '|
uniqueFilePath = filepath '|
'|
End If '|
'-------- [If .FileExists(filepath) Then] -------------------------------------------------------|
End With
End Function