Εμφάνιση ενός μόνο μηνύματος
  #4  
Παλιά 29-12-20, 09:13
tsgiannis Ο χρήστης tsgiannis δεν είναι συνδεδεμένος
Όνομα: Γιάννης
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Αγγλική
 
Εγγραφή: 08-12-2020
Μηνύματα: 153
Προεπιλογή

Επειδή λογικά βλέπω να μπερδεύονται καθώς σίγουρα θα υπάρχουν λάθη πρωτοκόλλησης το πιο εύκολο είναι να βάλεις 1 καλύτερο File Search όπως το Agent Ranshack.
Απο εκεί και πέρα
Ο παρακάτω κώδικας ψάχνει για όλα τα αρχεία σε 1 ριζικό φάκελο
Κώδικας:
Sub GetFiles(StartFolder As String, Pattern As String, _
             DoSubfolders As Boolean, ByRef colFiles As Collection)

    Dim f As String, sf As String, subF As New Collection, s
    
    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
    
    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        colFiles.Add StartFolder & f
        f = Dir()
    Loop
    
    If DoSubfolders then
        sf = Dir(StartFolder, vbDirectory)
        Do While Len(sf) > 0
            If sf <> "." And sf <> ".." Then
                If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                        subF.Add StartFolder & sf
                End If
            End If
            sf = Dir()
        Loop
    
        For Each s In subF
            GetFiles CStr(s), Pattern, True, colFiles
        Next s
    End If

End Sub
Δείγμα χρήσης
Κώδικας:
Dim colFiles As New Collection

GetFiles "C:\Users\Marek\Desktop\Makro\", FName & ".xls", True, colFiles
If colFiles.Count > 0 Then
    'work with found files
End If
Απάντηση με παράθεση