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