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

Forum (https://www.ms-office.gr/forum/)

- Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)

- - Δημιουργία Φακέλου και Υποφακέλου ταυτόχρονα (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/5484-dimioyrgia-fakeloy-kai-ypofakeloy-taytoxrona.html)

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

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

Κώδικας:

Dim result As Long

    result = MakeSureDirectoryPathExists("C:\Users\Giannis\Desktop\Test\Test1\Test2\Test3\") 

    ' Προσοχή!! Η τελευταία διαχωριστική κάθετος ( \ ) είναι απαραίτητη.

    If result = 0 Then

        MsgBox "Δεν ήταν δυνατή η δημιουργία φακέλου/ων"

    Else

        ' Ο/οι φάκελοι δημιουργήθηκαν ή υπάρχουν ήδη.

    End If

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

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

Κώδικας:

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

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

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

Κώδικας:

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