[VBA] Δημιουργία Backup πολλών αρχείων

[mak]

Καλησπερα σε όλους σας
Η ερωτηση μου ειναι η εξης : Εχω μια λίστα με αρχεια xls τα οποία χρειάζεται καθε τέλος μηνα να κραταμε ενα αντιγραφο backup με διαφορετικό όνομα. πχ. ενα αρχεο απο την λιστα είναι 153_name1.xls και το αντιγραφο του θα ειναι π.χ 153_2011_07.xls. Παραλληλα στο αντιγραφο δεν θα αποθηκευουνται καποιοι τυποι, αλλα μόνο οι τιμες των αποτελεσμάτων τους.
Μια προσπαθεια εγινε απο την πλευρά μου, "ερασιτεχνική", καταγραφοντας σε ενα module το παρακάτω κώδικα , τοσες φορες όσες και τα αρχεια της λίστας. Σιγουρα γίνεται με πολυ πιο γρήγορο τρόπο αλλά προς στιγμή το αποτελεσμα με ικανοποιει "μερικώς", εκτος απο το οτι καθε φορα που εκτελειται μια απο τις μακροεντολές οπως η παρακτω, το αρχειο που καλειται να ανοιξει απο την hyperlink που βρισκεται π.χ. στο B6 κελι, και επειδη αυτο περιεχει μακροεντολές και συνδεσεις με αλλα βιβλία, ζηταει να ενεργοποιηθουν οι μακροεντολές ή οχι και να ενημερωθουν ή οχι οι συνδεσεις. Γίνεται μεσα στο κώδικα να ορίσω τις απαντησεις στις δυο αυτές ερωτήσεις. (χωρις να τις απενεργοποιησω απο τις επιλογες) ???

Sub bak153()
' bak153 Μακροεντολή
Range("B6").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("ΕΙΣΠΡΑΞΗ").Select
Range("M10:O29").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ΚΑΤΑΣΤΑΣΗ").Select
tname = Range("AC5").Value
ChDir "C:\Documents and Settings\user\Τα έγγραφά μου\153_bak"
ActiveWorkbook.SaveAs Filename:=tname
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

[Tasos]

Μανώλη καλησπέρα!
Μπορείς να τα κάνεις όλα αυτά μέσα από ένα και μοναδικό βιβλίο.
Σου επισυνάπτω ένα παράδειγμα όπου μπορείς αφού συμπληρώσεις τα απαραίτητα πεδία
να μετατρέψεις τους τύπους των αρχείων ενός φακέλου σε τιμές και να τα αποθηκεύσεις στο φάκελο που έχεις προεπιλέξει.

Δοκίμασε το αρχικά σε κόπιες των αρχείων σου για να δεις αν είναι αυτό που χρειάζεσαι.

Αν χρειαστείς κάτι, εδώ είμαστε!

Με εκτίμηση

Τάσος

[mak]

Τασο καλησπερα
Δοκίμασα την εκδοχη που ανεβασες και πραγματικά είναι πολυ καλή σε αυτό που χρειάζομαι.

Εχω να παρατηρήσω πρωτα κάτι (οχι σημαντικό για την εφαρμογή μου, απλα για την ιστορία) :
Οταν δεν εχεις κανει check στο "Αντικατάσταση αρχείων με το ίδιο όνομα" τότε ακομα και αδειος να ειναι ο φακελος των αντγράφων, δεν δημιουργει κανενα αντίγραφο και στη στηλη "J" βγαζει "Υπάρχει ήδη αντίγραφό ασφαλείας!"

Τωρα θα ηθελα να ρωτησω δύο πραγματα.
α. Μπορει (?) το ονομα του αρχειου backup που δημιουργειται να κρατάει μονο τα τρία πρωτα ψηφια απο το παλιό ονομα -και οχι όλο - και να προσθετει την κατάληξη ????
π.χ. απο 153_name1.xls να γίνεται 153_2011_07.xls
β. Μπορει (?) να προστεθεί και δευτερη περιοχή τυπων (που θα επικολά μονο τις τιμές) με αντιστοιχο όνομα φύλλου ??? (Μια προσπαθεια απο την πλευρα μου να το κανω, κοιτωντας τον κωδικα του αρχειου, δεν βγηκε πουθενα)

και κατι τελευταιο, αν δεν έχω κουρασει ήδη
[ισως να επρεπε να το δημιουργησω ως ξεχωριστό θεμα στο forum, αλλά νομίζω ότι έχει άμμεση σχεση με αυτό]

Εχω μια περιοχη πχ Α2:Α100 με την πληρη διευθυνση κάποιων αρχειων (path\name) και στη περιοχη Β2:Β100 την νεα διευθυνση που θελω να αντιγραψω το καθε αρχειο αντιστοιχα.
(παραδειγμα στο αρχειο που εχω ανεβασει (test_bak.xls).
Τι κωδικα να χρησιμοποιησω για να το κανω μαζικα για όλα τα αρχεια ?.
(Θα χρησιμοποιω το test_bak πχ για να κανω copy
και ενα test_bak2 για να κάνω move καποια άλλα αρχεια. Λογικά θα ειναι ο ιδιος κώδικας με διαφορά στην εντολη copy και move ???)

Ευχαριστώ παρα πολύ

Φιλικά

Μανώλης

[Tasos]

Καλημέρα Μανώλη!

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

Από που προέρχονται οι τιμές αυτές;

Τάσος

[mak]

Καλημέρα Τασο !!
Στο αρχειο που ανεβασες στη σειρα 3 εχει "Όνομα Φύλλου όπου θα μετατροπούν οι τύποι:" και εισγουμε π.χ. ΕΙΣΠΡΑΞΗ και περιοχη Μ10:Ο29.
Το ζητουμενο αν μπορει να προστεθει - στο αρχειο που ηδη εχεις ανεβασει εννοειται - αλλο ενα set φυλλου και περιοχης πχ. (φυλλο ΠΛΗΡΩΜΗ και περιοχη Κ10:L29)

Ευχαριστω

[mak]

Το οποίο set θα κανει και αυτο την ιδια δουλεια ... αποθήκευση των αποτελεσματων και οχι των τυπων της περιοχής.

[Tasos]

Γεια σας!
Φίλε Μανώλη, έκανα κάποιες διορθώσεις στο παράδειγμα του προηγούμενου μηνύματος μου .
Δες το και προσανατολίσου στις τεχνικές που εφαρμόζονται.

Στο τελευταίο σου ερώτημα:

Ο παρακάτω κώδικας με ελάχιστες προσαρμογές πιστεύω ότι θα σε βοηθήσει.

Πριν τρέξεις τον κώδικα αυτό, πήγαινε στον VBE στο μενού Tools>References, βρες και τσέκαρε την επιλογή "Microsoft Scripting Runtime".

Option Explicit
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
                                             ByVal lpPath As String) As Long


Sub test()
    Dim c As Range, NewFileName As String
    Dim fso As New Scripting.FileSystemObject
    For Each c In Range("A2:A100")
        If Not IsEmpty(c) Then
            If fso.FileExists(c.Text) Then
                If Not fso.FolderExists(c.Offset(, 1).Text) Then MakeSureDirectoryPathExists c.Offset(, 1).Text
                If fso.FolderExists(c.Offset(, 1).Text) Then
                    NewFileName = Replace(c.Offset(, 1) & "\" & Mid$(c, InStrRev(c, "\") + 1), "\\", "\")
                    If Left(NewFileName, 1) = "\" Then NewFileName = "\" & NewFileName
                    fso.CopyFile Source:=c.Text, Destination:=NewFileName, OverWriteFiles:=True ' Αντιγραφή 
                    ' fso.MoveFile Source:=c.Text, Destination:=NewFileName ' Μεταφορά
                Else
                    '.....Ο φάκελος προορισμού δεν υπάρχει και ούτε πορεί να δημιουργηθεί
                End If
            Else
                '.......Το αρχείο/ πηγή δεν υπάρχει
            End If
        End If
    Next

End Sub

Καλή συνέχεια!

Τάσος

[mak]

Καλησπερα σε όλους
Φιλε Τάσο
Η διορθωμένη εκδοση του αρχειου σου, κανει οτι ακριβως ηθελα... και με το παραπάνω θα έλεγα.
Επισης και ο εξτρα κωδικας, για το copy και move είναι άψογος.

Ενα μεγαλο ευχαριστω για το χρόνο σου και την πολυτιμη βοηθεια σου !!!

Με εκτιμηση

Μανώλης