Fault with folder creation

[D Willett]

Hi. I recently updated some code which role is to check if a folder exists, if not create one and convert its case to "Propercase".
Initially I assumed "VBPropercase would do the trick and it didn't, so to work around this I used a piece of code to force this to happen.

Code: Select all

Public Function MakeProperCase(ByVal strString As String) As String
    Dim strText() As String
    Dim strTemp As String
    Dim i As Integer
    strText = Split(strString)
    For i = 0 To UBound(strText)
        If i = 0 Then
            strTemp = strTemp & StrConv(strText(0), vbProperCase)
        ElseIf Right$(strText(i - 1), 1) Like "[.!?]" Then
            strTemp = strTemp & StrConv(strText(i), vbProperCase)
        Else
            strTemp = strTemp & StrConv(strText(i), vbLowerCase)
        End If
        strTemp = strTemp & Space$(1)
    Next i
    MakeProperCase = strTemp
End Function

This is called by:

Code: Select all

Private Sub Command2_Click()

Dim strFolderName As String
Dim strFolderName2 As String


Me.Label1.Visible = True
Me.Label2.Visible = True
Me.txtOtherMan.Visible = True
Me.txtOtherMod.Visible = True
Me.txtFile.Visible = True

Dim FMan As String
Dim FMod As String
Dim FFile As String

FMan = InputBox("ManuFacturer")
FMod = InputBox("Model")

FFile = InputBox("Document Name")

Me.txtOtherMan.Text = FMan
Me.txtOtherMod.Text = FMod
Me.txtFile.Text = FFile



If FMan = "" Then
MsgBox "No Manufacturer", vbInformation, ""
Exit Sub
End If

If FMod = "" Then
MsgBox "No Model", vbInformation, ""
Exit Sub
End If

If FFile = "" Then
MsgBox "No File", vbInformation, ""
Exit Sub
End If


strFolderName = "L:\mmpdf\QuickMethod\" & MakeProperCase(FMan) & "\"
strFolderName2 = "L:\mmpdf\QuickMethod\" & MakeProperCase(FMan) & "\" & MakeProperCase(FMod) & "\"

If Dir(strFolderName, vbDirectory) = "" Then
   MkDir strFolderName
End If

If Dir(strFolderName2, vbDirectory) = "" Then
   MkDir strFolderName2
End If



FFile = Replace$(StrConv(FFile, vbProperCase), " ", "-")

FileCopy Me.txtMethDesc.Text, strFolderName2 & FFile & ".pdf"
MsgBox "Method Saved to Collection", vbInformation, ""
Unload Me
End Sub

What seems to be happening now is duplicate folders created.
The duplicate folder is then none deletable and causing problems.
Can anyone review my code and see if there is anything untowards with it>?

Thanks

[HansV]

Windows shouldn't be able to create duplicate folders. What exactly do you mean?

[D Willett]

Hi Hans. In this case it is the Nissan folder.
Checking the foldername I can't see an extra "Space" or anything, they are exactly the same??

[Rudi]

Hi Hans. In this case it is the Nissan folder.
Checking the foldername I can't see an extra "Space" or anything, they are exactly the same??

Might sound weird to ask, but is that duplicate folder actually existing? What happens if you refresh the parent folder by pressing F5? If its just a screen refresh thing, the folder should disappear.

[D Willett]

Just tried Hans, it still exists and impossible to delete one of them. I was looking in the code to see how this could happen I can't see anything..

[HansV]

Does it work better if you change

Code: Select all

    strFolderName = "L:\mmpdf\QuickMethod\" & MakeProperCase(FMan) & "\"
    strFolderName2 = "L:\mmpdf\QuickMethod\" & MakeProperCase(FMan) & "\" & MakeProperCase(FMod) & "\"

to

Code: Select all

    strFolderName = "L:\mmpdf\QuickMethod\" & MakeProperCase(FMan)
    strFolderName2 = strFolderName & "\" & MakeProperCase(FMod)

You'd have to insert a backslash into the FileCopy instruction, of course:

Code: Select all

    FileCopy Me.txtMethDesc.Text, strFolderName2 & "\" & FFile & ".pdf"

[D Willett]

Hi Hans
I think we're creating a space after (FMan) see below: Error 76?

[D Willett]

Hans
I'm trying a different routine from DaniWEb:

Code: Select all

Public Function InitCapWord(ByVal mString As String) As String
Dim mRet As String
If Len(Trim(mString)) > 1 Then
    Dim mFirst As String
    Dim mRest As String
    mFirst = UCase(Mid(mString, 1, 1))
    mRest = LCase(Right(mString, Len(mString) - 1))
    mRet = mFirst & mRest
Else
    mRet = mString
End If
InitCapWord = mRet
End Function

Code: Select all

strFolderName = "L:\mmpdf\QuickMethod\" & InitCapWord(FMan) & "\"
strFolderName2 = "L:\mmpdf\QuickMethod\" & InitCapWord(FMan) & "\" & InitCapWord(FMod) & "\"

Code: Select all

FileCopy Me.txtMethDesc.Text, strFolderName2 & FFile & ".pdf"

It seems to be ok on initial testing...(hopefully)

[HansV]

Ah yes - you add one space too many in MakeProperCase: change the code for this function to

Code: Select all

Public Function MakeProperCase(ByVal strString As String) As String
    Dim strText() As String
    Dim strTemp As String
    Dim i As Integer
    strText = Split(strString)
    For i = 0 To UBound(strText)
        If i = 0 Then
            strTemp = strTemp & StrConv(strText(0), vbProperCase)
        ElseIf Right$(strText(i - 1), 1) Like "[.!?]" Then
            strTemp = strTemp & StrConv(strText(i), vbProperCase)
        Else
            strTemp = strTemp & StrConv(strText(i), vbLowerCase)
        End If
        If i < UBound(strText) Then
            strTemp = strTemp & Space$(1)
        End If
    Next i
    MakeProperCase = strTemp
End Function

[D Willett]

Ok Hans.
Yes I saw the space stepping through. I'll just see how Dani's version works, if it doesn't then I can come back to this (unless you advise not to use the Dani version)

Thanks Again.

[HansV]

The version from Daniweb is more efficient, so I'd use that.

[D Willett]

Ok many thanks