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)

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

Καλσπερα .Εχω παρει μια βαση απο την αναρτηση εδω http://www.ms-office.gr/forum/access...df-ston-c.html

Θα ηθελα αν γινεται στο κουμπι "Δημιουργια φακελου"αντι να δημιουργει ταυτοχρονα φακελο και υποφακελο σε path που θα επιλεξω εγω αν γινεται μεσω vba βαση του κωδικα αυτου.

Βρηκα την μιση λυση .Εχω τον κωδικα αυτον

Κώδικας:

Option Explicit
 
 

Const strParentFolder As String = "C:\"

Public Function MakeNameFolder() As String

    Dim strName As String

    

    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

Mε βαση τον κωδικα αυτον μπορει να δημιουργειται και ενας φακελος στον C:\ και μετα να δημιουργειται ο φακελος με ΟΝΟΜΑ-ΕΠΙΘΕΤΟ .Το αποτελεσμα δηλαδη να ειναι c:\test\ΟΝΟΜΑ_ΕΠΙΘΕΤΟ

Καλημέρα

Γιάννη θα μπορούσες:

1) Στον φάκελλο "c:\ " να δημιουργήσεις τον υποφάκελο "test" και

2) Στον κώδικα να αλλάξεις τη 2η γραμμή μετά το ίσον (=) σε: "c:\test\"

Καλημερα
Το σκεφτηκα αυτο απλα ελεγα αν γινεται αυτοματοποιημενα .Ισως με εντολη MlDir?

Γιατί να αυτοματοποιήσω κάτι που το κάνω μία μόνο φορά και μάλιστα πολύ εύκολα;

Ελεγα επειδη η βαση θα παει σε αλλο pc.Θα μου πεις και εκει τωτα παλι μπορω να κανω φακελο.Εκτος αν ειναι πολυπλοκο οποτε παω πασο

Μετά τη γραμμή κώδικα: Dim strName As String στην 1η συνάρτηση

πρόσθεσε τον κώδικα:

Κώδικας:

    If Dir(strParentFolder, vbDirectory) = "" Then

        MkDir strParentFolder

    End If

Ο κώδικας ελέγχει αν υπάρχει ο φάκελος strParentFolder (=c:\test\) και αν δεν υπάρχει τον δημιουργεί.

Σε ευχαριστω Γιωργο δουλεψε.

"Ενημερωτικα.Η γραμμη στον κωδικα = "" τι ελεγχει?

Γεια σας!

Γιάννη σύμφωνα με τον τίτλο του άρθρου σου (Δημιουργία φακέλου και υποφακέλου ταυτόχρονα) θα έλεγα ότι η MkDir θα δημιουργήσει φάκελο μόνο αν υπάρχει ο γονικός φάκελος.

Τι εννοώ:
Έστω ότι έχουμε το φάκελο "C:\Users\Giannis\Desktop\Test\" μέσα στον οποίο θέλουμε να δημιουργήσουμε προγραμματιστικά .\Test1\Test2\Test3 ώστε να έχουμε : "C:\Users\Giannis\Desktop\Test\Test1\Test2\Test3\

Δεν θα λειτουργήσει απ' ευθείας με την MkDir.

Μπορεί να χρησιμοποιηθεί η εξής συνάρτηση API:

Κώδικας:

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

για να δημιουργηθούν οι φάκελοι .\Test1\Test2\Test3\ αν δεν υπάρχουν ήδη.

Μπορεί κανείς να καλέσει τη συνάρτηση ως εξής:

Κώδικας:

Sub test()

    Dim result As Long

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

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

    If result = 0 Then

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

    Else

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

    End If
 

End Sub

Τασο Σε ευχαρΙστω και για την δικια σου τοποθετηση.Ομως αφου εξαρχεις δηλωνω ποιοι φακελοι θα γινουν

Κώδικας:

Const strParentFolder As String = "C:\test\"

Κώδικας:

If Dir(strParentFolder, vbDirectory) = "" Then

        MkDir strParentFolder

    End If

Οποτε (ισως και να καταλαβαινω κατι λαθος) ποια η διαφορα με την συναρτηση που προτεινεις?