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

[ggreg75]

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

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

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

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

Γρηγόρης

[kapetang]

Καλησπέρα

Γρηγόρη, βάλε σε μια φόρμα ένα κουμπί (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

[ggreg75]

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

[ggreg75]

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

[kapetang]

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

[ggreg75]

Γιώργο καλησπέρα. Αντιμετωπίζω ένα επιπλέον θέμα. Κάποια 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.

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

Γρηγόρης

[kapetang]

Καλησπέρα

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

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

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

[ggreg75]

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

[ggreg75]

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

[kapetang]

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