Δημιουργία Φακέλου και Υποφακέλου ταυτόχρονα

[gianniskar]

Τασο με μπερδεψε λιγο για το που θα βαλω τον κωδικα. Δες λιγο τον δικο μου κωδικα ξανα στο συγκεκριμενο κουμπ

Option Compare Database
Option Explicit
Const strParentFolder As String = "C:\test\"
Public Function MakeNameFolder() As String
    Dim strName As String
            If Dir(strParentFolder, vbDirectory) = "" Then
               MkDir strParentFolder
    End If
    If Len(Me.ÏÍÏÌÁ) * Len(Me.ÅÐÉÈÅÔÏ) Then
        strName = Replace(Me.ÏÍÏÌÁ, " ", "_") & "_" & _
                  Replace(Me.ÅÐÉÈÅÔÏ, " ", "_")

        MakeNameFolder = strParentFolder & strName
    End If
End Function
Private Sub cmdCreateFolder_Click()
     Dim strNewFolder As String

    On Error GoTo err_Hander

    strNewFolder = MakeNameFolder
    If strNewFolder <> "" Then
        If Dir(strNewFolder, vbDirectory) = "" Then
            MkDir strNewFolder
            MsgBox "ÄçìéïõñãÞèçêå öÜêåëïò" & vbCrLf & strNewFolder
        Else
            MsgBox "Ï öÜêåëïò õðÜñ÷åé" & vbCrLf & strNewFolder
        End If
    Else
        MsgBox "ÕðÜñ÷ïõí êåíÜ ðåäßá"
    End If
    Exit Sub
err_Hander:
    MsgBox "Error #" & err.Number & vbCrLf & err.Description
End Sub



Private Sub cmdMyButton_Click()
    Dim strFolder As String
    
    strFolder = MakeNameFolder
    If strFolder <> "" Then
        If Dir(strFolder, vbDirectory) = "" Then
            MsgBox "Ï öÜêåëïò äåí õðÜñ÷åé" & vbCrLf & strFolder
        Else
            Shell "EXPLORER.EXE" & " " & Chr(34) & strFolder & Chr(34), vbNormalFocus
        End If
    Else
        MsgBox "ÕðÜñ÷ïõí êåíÜ ðåäßá"
    End If
End Sub