Creating Folders with Invalid Characters

[Benjamin Bolduc]

Hello everyone,

I'm working on a customer file management system for our database. The purpose is to provide a quick link to all of the files within a customers specific folder.

Open selecting a customer, a folder is created using the [Account Name], (If it does not already exist.) You can then select a file to open from a combobox or click a button to open the folder to paste files into it.

It is working great so far except for one problem. If the Account Name has invalid characters, such as \/:*?"<>|, it cannot create the folder.

Is there a way to modify the folder name to change the invalid characters? If the folder name is different from the Account Name, how can it query it?

I appreciate your help as I have limited knowledge in VBA. Here is the code I am working with:


Private Sub cbSelectFile_AfterUpdate()
On Error GoTo Err_cbSelectFile_AfterUpdate
Dim cPath As String
cPath = "\\Dataserver2\Database\Monadnock Security Systems Inc. Database\Customer Files\" & Forms![Central Form]![Account Name] & "\"

Me.tbHidden.SetFocus

Application.FollowHyperlink cPath & "\" & cbSelectFile

Exit_cbSelectFile_AfterUpdate:
Exit Sub

Err_cbSelectFile_AfterUpdate:
If Err.Number = 432 Then 'File name or class not found during Automation operation
MsgBox "The '" & cbSelectFile & "' file can not be opened.", vbCritical, "Invalid File Type"
Exit Sub
Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_cbSelectFile_AfterUpdate
End If

End Sub


Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open
Dim cPath As String
cPath = "\\Dataserver2\Database\Monadnock Security Systems Inc. Database\Customer Files\" & Forms![Central Form]![Account Name] & "\"

On Error Resume Next
If Dir(cPath, vbDirectory) > vbNullString Then

End If
MkDir cPath
On Error GoTo Err_Form_Open

Me.lcbSelectFile.Caption = "Select a file to open from " & Forms![Central Form]![Account Name] & " folder:"

Dim lngCount As Long
lngCount = Me.cbSelectFile.ListCount

Call Update_cbSelectFile

Exit_Form_Open:
Exit Sub

Err_Form_Open:
If Err.Number = 76 Then 'path not found
MsgBox "You do not have access to the " & cPath & " directory.", vbCritical, "Directory Access Error"
Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Form_Open
End If

End Sub


Public Function Update_cbSelectFile()
On Error GoTo Err_Update_cbSelectFile
Dim cPath As String
cPath = "\\Dataserver2\Database\Monadnock Security Systems Inc. Database\Customer Files\" & Forms![Central Form]![Account Name] & "\"

Dim sPath As String
Dim sFileList As String
Dim sFileName As String

sFileList = ""
sFileName = Dir(cPath)
Do While sFileName <> ""
sFileList = sFileList & sFileName & ";"
sFileName = Dir
Loop

Me.cbSelectFile.RowSource = sFileList
Me.cbSelectFile.Requery

Exit_Update_cbSelectFile:
Exit Function

Err_Update_cbSelectFile:
If Err.Number = 2176 Then 'The setting for this property is too long
MsgBox "Combo box can not contain more than 255 records. No records will be displayed.", vbCritical, "Record Source Error"
Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Update_cbSelectFile
End If

End Function

 

[Guus2005]

didn't read you whole post. perhaps this is of any help to you:

You could replace the \/:*?"<>|, characters by their respective ascii numbers and restore them when needed.

Public Function ConvSpecial2Normal(str2bConverted As String)

    Dim intLen    As Integer
    Dim strChar   As String * 1
    Dim strPaste  As String
    Dim strRetVal As String

    For intLen = 1 To Len(str2bConverted)
        strChar = Mid$(str2bConverted, intLen, 1)
        Select Case strChar
        Case "\", "/", ":", "*", "?", """", "<", ">", "|", ","
            strPaste = "[" & Asc(strChar) & "]"
        Case Else
            strPaste = strChar
        End Select
        strRetVal = strRetVal & strPaste
    Next intLen

    ConvSpecial2Normal = strRetVal
    
End Function

 

[Guus2005]

The restore procedure:

Public Function ConvNormal2special(str2bConverted As String)

    Dim aAsc(9, 1) As String
    Dim intX       As Integer
    Dim strRetVal  As String
    
    aAsc(0, 0) = "\":  aAsc(0, 1) = "[" & Asc(aAsc(0, 0)) & "]"
    aAsc(1, 0) = "/":  aAsc(1, 1) = "[" & Asc(aAsc(1, 0)) & "]"
    aAsc(2, 0) = ":":  aAsc(2, 1) = "[" & Asc(aAsc(2, 0)) & "]"
    aAsc(3, 0) = "*":  aAsc(3, 1) = "[" & Asc(aAsc(3, 0)) & "]"
    aAsc(4, 0) = "?":  aAsc(4, 1) = "[" & Asc(aAsc(4, 0)) & "]"
    aAsc(5, 0) = """": aAsc(5, 1) = "[" & Asc(aAsc(5, 0)) & "]"
    aAsc(6, 0) = "?":  aAsc(6, 1) = "[" & Asc(aAsc(6, 0)) & "]"
    aAsc(7, 0) = "?":  aAsc(7, 1) = "[" & Asc(aAsc(7, 0)) & "]"
    aAsc(8, 0) = "?":  aAsc(8, 1) = "[" & Asc(aAsc(8, 0)) & "]"
    aAsc(9, 0) = "?":  aAsc(9, 1) = "[" & Asc(aAsc(9, 0)) & "]"
    
    strRetVal = str2bConverted
    For intX = 0 To 9
        strRetVal = Replace(strRetVal, aAsc(intX, 1), aAsc(intX, 0))
    Next intX

    ConvNormal2special = strRetVal
End Function

 

[Guus2005]

Examples:

ConvSpecial2Normal("F:\ISE\Se-092749\?Se-CrossEntity*\Se-ISTPMPO/\Development\EDB2\EDB2Data.mdb")

result:

F[58][92]ISE[92]Se-092749[92][63]Se-CrossEntity[42][92]Se-ISTPMPO[47][92]Development[92]EDB2[92]EDB2Data.mdb

Restore:

ConvNormal2special("F[58][92]ISE[92]Se-092749[92][63]Se-CrossEntity[42][92]Se-ISTPMPO[47][92]Development[92]EDB2[92]EDB2Data.mdb")

Use these functions when you create a filename and when you compare the filename to your source.

Enjoy!

 

[Benjamin Bolduc]

This worked perfectly! I couldn't have asked for a better solution to my problem. Thank you for taking the time to post.

-Ben Bolduc