Define New Valid Folder Name

[gmaxey]

Cross posted in Microsoft Office forums:
http://www.msofficeforums.com/word-v...lder-name.html

I'm working on a project where the user is required to identify a new unique folder name prior to further processing.

If the folder identified already exists processing cannot continue. If the folder identified is invalid (invalid characters or reserved) then processing cannot continue.

The only thing I can think of is:
1) Check if folder exists and
2) Try to create the folder and if it fails ...

I created the following function. Anyone have a better idea?


Code:

Sub Test()
  MsgBox fcnIsNewValidFolderName("Test") 'New valid folder name.
  MsgBox fcnIsNewValidFolderName("My Documents") 'Existing folder - returns false
  MsgBox fcnIsNewValidFolderName("A*B?C") 'Invalid characters in name - returns false
  MsgBox fcnIsNewValidFolderName("PRN") 'Reserved name - returns false
lbl_Exit:
  Exit Sub
End Sub

Function fcnIsNewValidFolderName(strFolder As String) As Boolean
Dim oFSO As Object, oRootFolder As Object, oFolder As Object
  fcnIsNewValidFolderName = True
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  On Error GoTo Err_Root
  Set oRootFolder = oFSO.GetFolder("D:\")
  On Error GoTo Err_Create
  Set oFolder = oRootFolder.SubFolders(strFolder)
  fcnIsNewValidFolderName = False
  GoTo lbl_Exit
CreateReEntry:
  On Error GoTo Err_Last
  'See if a folder can be created using the folder name passed.
  Set oFolder = oFSO.CreateFolder(oRootFolder & Application.PathSeparator & strFolder)
  oFolder.Delete
lbl_Exit:
  Set oFSO = Nothing
  Exit Function
Err_Root:
  fcnIsNewValidFolderName = True
  Resume lbl_Exit
Err_Create:
  Resume CreateReEntry:
Err_Last:
  Beep
  fcnIsNewValidFolderName = False
  Resume lbl_Exit
End Function

__________________
Greg Maxey
Please visit my web site athttp://gregmaxey.mvps.org

[SamT]

Tested for folder creation, folder exists and for one illegal character

Function SamT_fcnIsNewValidFolderName(NewFolderName As String) As Boolean
  Const RootFolder As String = "D:/"
   Dim FSO As Object
   Set FSO = CreateObject("Scripting.FileSystemObject")
   
'Illegal Characters
    Dim IllegalCharacter
    Dim i As Long
    IllegalCharacter = Array("/", "\", "[", "]", "*", "?", ":") 'Edit to suit
    For i = LBound(IllegalCharacter) To UBound(IllegalCharacter)
          If InStr(NewFolderName, IllegalCharacter(i)) > 0 Then
          MsgBox "Oopsies! YOU CAN'T DO THAT"
          GoTo GraceFulExit
        End If
    Next
 
 'File Exists
  SamT_fcnIsNewValidFolderName = Not FSO.FolderExists(RootFolder & NewFolderName)
  If Not SamT_fcnIsNewValidFolderName Then
    MsgBox "Oopsies! FOLDER EXISTS!"
    GoTo GraceFulExit
  End If
   
  'Create Folder
  On Error Resume Next
  FSO.CreateFolder (RootFolder & NewFolderName)
  SamT_fcnIsNewValidFolderName = FSO.FolderExists(RootFolder & NewFolderName)
  If SamT_fcnIsNewValidFolderName Then 
GoTo GraceFulExit
Else  
 MsgBox "Oopsies! UNKNOWN ERROR!"
End If
 
GraceFulExit:
Set FSO = Nothing
End Function

Sub Test_SamT_fcnIsNewValidFolderName()
Dim X
X = SamT_fcnIsNewValidFolderName("AAAFolder")
X = SamT_fcnIsNewValidFolderName("AAAFolder")
X = SamT_fcnIsNewValidFolderName("AAA[Folder")
End Sub

[gmaxey]

Sam,

Thanks. I've already incorporated the FSO.FolderExists method. My actual code is part of a larger project with a userform. I decided to use the KeyPress event to prevent invalid characters. I also added this bit:

  Select Case strFolder
    Case "CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", _
         "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", _
         "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", _
         "LPT7", "LPT8", "LPT9"
        fcnIsNewValidFolderName = False
        With lbl_InvalidFolder
          .ForeColor = wdColorRed
          .Caption = "Invalid - Reserved folder name"
        End With
        Exit Function
  End Select

Here is an interesting bit. Characters such as Chr(32) "a space" and "." are valid in folder names but a string of " " or "......." is not. However oFSO.FolderExists processes them as if they exist.