Σε αυτό το άρθρο, θα δημιουργήσουμε μια μακροεντολή για να παραθέσουμε όλα τα αρχεία μέσα στο φάκελο.
Κατά την εκτέλεση της μακροεντολής, το όνομα του αρχείου μαζί με τη διαδρομή του αρχείου θα εμφανιστεί ξεκινώντας από το κελί A17.
Λογική εξήγηση
Σε αυτό το άρθρο έχουμε δημιουργήσει δύο μακροεντολές, "subfolder_files" και "getting_filelist_in_folder".
Η μακροεντολή "subfolder_files" παίρνει τη διαδρομή του φακέλου και την τιμή boolean ως εισόδους και επιστρέφει το όνομα του αρχείου στο φάκελο.
Το "getting_filelist_in_folder" χρησιμοποιείται για την κλήση της μακροεντολής "subfolder_files". Παρέχει την τιμή διαδρομής φακέλου στη μακροεντολή, με την τιμή boolean να έχει οριστεί ως "true". Επίσης, όταν απαιτούνται ονόματα αρχείων στους δευτερεύοντες φακέλους, τότε εκχωρούμε boolean τιμή 'true'.
Επεξήγηση κώδικα
folder_path = Sheet1.TextBox1.Value
Ο παραπάνω κώδικας χρησιμοποιείται για την εξαγωγή τιμής συμβολοσειράς από το πλαίσιο κειμένου.
Κλήση subfolder_files (folder_path, True)
Ο παραπάνω κώδικας χρησιμοποιείται για την κλήση της μακροεντολής "subfolder_files". Εκχωρεί τη διαδρομή φακέλου και ορίζει την ιδιότητα "include_subfolder" true.
Ορισμός fso = CreateObject ("scripting.filesystemobject")
Ο παραπάνω κώδικας χρησιμοποιείται για τη δημιουργία αντικειμένου συστήματος αρχείων.
Ορισμός υποφακέλου1 = fso.getfolder (folder_path)
Ο παραπάνω κώδικας χρησιμοποιείται για τη δημιουργία του αντικειμένου του καθορισμένου φακέλου.
Για κάθε φάκελο1 Σε υποφάκελο1.υποφάκελοι
Κλήση subfolder_files (folder1, True)
Επόμενο
Ο παραπάνω κώδικας χρησιμοποιείται για την αναζήτηση όλων των υποφακέλων, στον κύριο φάκελο.
Dir (folderpath1 & "*.xlsx")
Ο παραπάνω κώδικας χρησιμοποιείται για να λάβετε το όνομα αρχείου excel.
Ενώ όνομα αρχείου ""
count1 = count1 + 1
ReDim Preserve filearray (1 To count1)
filearray (count1) = όνομα αρχείου
όνομα αρχείου = Dir ()
Διευθύνω
Ο παραπάνω κώδικας χρησιμοποιείται για τη δημιουργία ενός πίνακα, ο οποίος αποτελείται από όλα τα ονόματα αρχείων που υπάρχουν στο φάκελο.
Για i = 1 To UBound (filearray)
Κελιά (lastrow, 1). Value = folderpath1 & filearray (i)
lastrow = lastrow + 1
Επόμενο
Ο παραπάνω κώδικας χρησιμοποιείται για την εκχώρηση ονόματος αρχείου μέσα στον πίνακα στο βιβλίο εργασίας.
Ακολουθήστε παρακάτω για τον κωδικό
Option Explicit Sub subfolder_files (folderpath1 As Variant, Optional include_subfolder As Boolean) 'Έλεγχος αν θα συμπεριληφθεί ή όχι υποφάκελος If include_subfolder Στη συνέχεια' Δήλωση μεταβλητών Dim όνομα αρχείου, filearray () As String Dim lastrow, count1, i As Integer 'Έλεγχος εάν η διαδρομή φακέλου περιέχει backslash ως τελευταίος χαρακτήρας If Right (folderpath1, 1) "\" Στη συνέχεια, folderpath1 = folderpath1 & "\" End If 'Λήψη του ονόματος αρχείου του πρώτου αρχείου στην καθορισμένη διαδρομή φακέλου filename = Dir (folderpath1 & "*.xlsx")' Λήψη του αριθμού σειράς του τελευταίου κυττάρου count1) = όνομα αρχείου filename = Dir () Wend On Error GoTo last 'Προσθήκη ονόματος αρχείου στο βιβλίο εργασίας Για i = 1 σε UBound (filearray) Cells (lastrow, 1). Value = folderpath1 & filearray (i) lastrow = lastrow + 1 Next Λήξη Αν τελευταία: Τερματισμός υπο -λήψης_filelist_in_folder () 'Δήλωση μεταβλητών Dim folder_path As String Dim fso As Object, folder1, subfolder1 As Object' Getting path of the folder folder_path = Sheet1.TextBox1.Value 'Έλεγχος αν η διαδρομή του φακέλου περιέχει ανάστροφη πλάκα ως τελευταίο χαρακτήρα If Right (folder_path, 1) " \ "Στη συνέχεια, folder_path = folder_path &" \ "Τερματισμός Αν 'Κλήση μακροεντολής subfolder_files Κλήση subfolder_files (folder_path, True)' Δημιουργία αντικειμένου αντικειμένου συστήματος αρχείων Set fso = CreateObject (" scripting.filesystemobject ") Ορισμός υποφακέλου1 = fso.getfolder (folder_path) 'Looping through every subfolder For each folder1 In subfolder1.subfolders Call the subfolder_files (folder1, True) Next End Sub
Αν σας άρεσε αυτό το blog, μοιραστείτε το με τους φίλους σας στο Facebook. Επίσης, μπορείτε να μας ακολουθήσετε στο Twitter και το Facebook.
Θα θέλαμε πολύ να σας ακούσουμε, ενημερώστε μας πώς μπορούμε να βελτιώσουμε το έργο μας και να το κάνουμε καλύτερο για εσάς. Γράψτε μας στον ιστότοπο email