Εμφάνιση ενός μόνο μηνύματος
  #7  
Παλιά 21-05-17, 21:10
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Καλησπέρα

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

Κώδικας:
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
Ο κώδικας αντιγράφει τα αρχικά αρχεία δίνοντας στα αντίγραφα τα επιθυμητά ονόματα. Ακολούθως, αν συμφωνούμε, διαγράφει και τα αρχικά αρχεία.
Απάντηση με παράθεση