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/4576-maziki-metonomasia-arxeion.html)

Μαζική μετονομασία αρχείων

Καλησπέρα σε όλη την ομάδα.
Θα ήθελα την εξής βοήθεια. Έχω έναν φάκελο με pdf αρχεία για τα οποία θα ήθελα να προχωρήσω σε μία μαζική μετονομασία καθώς στην αρχή της κάθε ονομασίας πρέπει να εισάγω ένα κωδικό.

Έχοντας έναν πίνακα με τα πεδία Current_File_Name και New_File_name, θα μπορούσαμε μέσω κώδικα VBA να φτιάξουμε μία διαδικασία προκειμένου να γίνεται μαζικά η μετονομασία των αρχείων;

Τα πεδία έχουν ενδεικτικά τις κάτωθι τιμές :
Current_File_Name : C:\pdfFiles\1234.pdf
New_File_name: C:\pdfFiles\ABC_1234.pdf

Ευχαριστώ εκ των προτέρων

Γρηγόρης

Καλησπέρα

Γρηγόρη, βάλε σε μια φόρμα ένα κουμπί (cmdSetNewName) και, στο συμβάν κλικ , πρόσθεσε τον κώδικα:

Κώδικας:

Private Sub cmdSetNewName_Click()

    Dim rs As DAO.Recordset, tblName As String

    Dim OldName As String, NewName  As String
 
 

    On Error GoTo errHandler

    tblName = "Table1"  'Εδώ ορίζεται το πραγματικό όνομα του πίνακα

    Set rs = CurrentDb.OpenRecordset(tblName)

    With rs

        If .RecordCount Then

            Do Until .EOF

                OldName = !Current_File_Name: NewName = !New_File_name

                If Dir(OldName) <> "" Then

                    Name OldName As NewName

                End If

                .MoveNext

            Loop

        End If

        MsgBox "Η μετανομασία ολοκληρώθηκε"

    End With

Exit_Sub:

    Set rs = Nothing

    Exit Sub

errHandler:

    MsgBox Err.Description, vbCritical, "Error #" & Err.Number

    Resume Exit_Sub

End Sub

Ευχαριστώ πολύ Γιώργο! Θα το δοκιμάσω

Είναι αυτό που χρειαζόμουν! Ευχαριστώ πολύ Γιώργο

Γρηγόρη να είσαι καλά.

Γιώργο καλησπέρα. Αντιμετωπίζω ένα επιπλέον θέμα. Κάποια pdf συνδέονται με περισσότερους τους ενός κωδικούς. Δηλαδή μπορεί για παράδειγμα να έχω 10 pdf που να συνδέονται με 12 κωδικούς.
Αυτό θα έχει ως αποτέλεσμα στον πίνακα «Rename» (έτσι τον έχω ονομάσει) να υπάρχουν διπλότυπες εγγραφές στο πεδίο «Current_File_Name»

Π.χ
Current_File_Name | New_File_name
C:\pdfFiles\1234.pdf | C:\pdfFiles\001_1234.pdf
C:\pdfFiles\1234.pdf | C:\pdfFiles\002_1234.pdf
C:\pdfFiles\1234.pdf | C:\pdfFiles\003_1234.pdf

Υπάρχει η δυνατότητα, όταν εντοπίζει τέτοιες περιπτώσεις να προχωρά σε δημιουργία αντιγράφων των pdf αρχείων και εν συνεχεία να μετονομάσει και τα αντίγραφα;

Προς το παρόν αυτό που κάνω είναι, για τις μοναδικές εγγραφές να μετονομάσω τα pdf με τον τρόπο που θέλω ενώ για τις διπλότυπες, να διατηρώ την ίδια ονομασία εισάγοντας τον χαρακτήρα underscore στην αρχή της αρχικής ονομασίας για να μπορώ να τα εντοπίσω. Μετά κάνω copy και rename manually.

Ευχαριστώ για την πολύτιμη βοήθεια σου

Γρηγόρης

Καλησπέρα

Γρηγόρη, δοκίμασε τον κώδικα:

Κώδικας:

Private Sub cmdCopyFiles_Click()

    Dim rs As DAO.Recordset, tblName As String, x As String

    Dim OldName As String, NewName As String
 

    On Error GoTo errHandler

    tblName = "Rename"  'Εδώ ορίζεται το πραγματικό όνομα του πίνακα

    Set rs = CurrentDb.OpenRecordset(tblName)
 

    With rs

        If .RecordCount Then

            Do Until .EOF

                OldName = !Current_File_Name: NewName = !New_File_name

                If Dir(OldName) <> "" Then

                    If Dir(NewName) = "" Then

                        FileCopy OldName, NewName

                    End If

                End If

                .MoveNext

            Loop

            Set rs = Nothing

            If MsgBox("Η αντιγραφή και μετανομασία ολοκληρώθηκε." & vbCrLf & _

                    "          Να διαγραφούν τα αρχικά αρχεία;", vbYesNo) = vbYes Then

                KillFiles tblName

            End If

        End If

    End With

    Exit Sub

errHandler:

    MsgBox Err.Description, vbCritical, "Error #" & Err.Number

End Sub
 

Public Sub KillFiles(tblName As String)

    Dim rs As DAO.Recordset, OldName As String
 

    Set rs = CurrentDb.OpenRecordset(tblName)

    With rs

        If .RecordCount Then

            Do Until .EOF

                OldName = !Current_File_Name

                If Dir(OldName) <> "" Then

                    Kill OldName

                End If

                .MoveNext

            Loop

        End If

    End With
 

End Sub

Ο κώδικας αντιγράφει τα αρχικά αρχεία δίνοντας στα αντίγραφα τα επιθυμητά ονόματα. Ακολούθως, αν συμφωνούμε, διαγράφει και τα αρχικά αρχεία.

Θα το δοκιμάσω. Ευχαριστώ πολύ Γιώργο Για την βοήθεια σου

Γιώργο καλησπέρα. Δεν βρίσκω τρόπο να σε ευχαριστήσω. Η βοήθεια σου ήταν πολύτιμη για εμένα. Να είσαι πάντα καλά!

Να είσαι καλά, Γρηγόρη