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

[Tasos]

Θα σου χρησιμεύσει όταν θα χρειαστεί να δημιουργήσεις ή να ανοίξεις υποφακέλους σε περισσότερα επίπεδα ταυτόχρονα στον γονικό φάκελο
πχ. C:\test\Ονομα_Πελάτη_123456789\Βιβλ ία\Τρίμηνο1\ kok.

[gianniskar]

Καλημερα .Οκ θα την δοκιμασω αλλα που σε ποιο σημειο θα βαλω τον κωδικα

Dim result As Long
    result = MakeSureDirectoryPathExists("C:\Users\Giannis\Desktop\Test\Test1\Test2\Test3\") 
    ' Προσοχή!! Η τελευταία διαχωριστική κάθετος ( \ ) είναι απαραίτητη.
    If result = 0 Then
        MsgBox "Δεν ήταν δυνατή η δημιουργία φακέλου/ων"
    Else
        ' Ο/οι φάκελοι δημιουργήθηκαν ή υπάρχουν ήδη.
    End If

[Tasos]

Καλημέρα Γιάννη!

Αν χρειαστεί θα προσθέσεις τη συνάρτηση στην κορυφή του κώδικα και θα αντικαταστησεις:

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

με

    Dim result As Long
    result = MakeSureDirectoryPathExists("C:\Users\Giannis\Desktop\Test\Test1\Test2\Test3\") 
    ' Προσοχή!! Η τελευταία διαχωριστική κάθετος ( \ ) είναι απαραίτητη.
    If result = 0 Then
        MsgBox "Δεν ήταν δυνατή η δημιουργία φακέλου/ων"
    Else
        ' Ο/οι φάκελοι δημιουργήθηκαν ή υπάρχουν ήδη.
        ' συνέχισε τον κώδικα σου εδώ....
    End If

[gianniskar]

ok θα το δοκιμασω

[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