Подсчитать файлы, содержащие указанное значение - PullRequest
0 голосов
/ 08 июля 2019

Мне нужно написать макрос для подсчета файлов, имя файла которых содержит «Финансы».

Я попытался выполнить следующие коды, но это не работает.Я понятия не имею, что это неправильно или правильно.

Диапазон ("B6") - Финансы.

Dim FolderPath As String
Dim Path As String
Dim count As Integer
Dim countFile As Integer
Dim Folder As String

FolderPath = Range("B2")
Path = FolderPath & "\*.xls"
Filename = Dir(Path)

If Folder = vbNullString Then
    Range("C6").Interior.ColorIndex = 4
Else
    Range("C6").Interior.ColorIndex = 3
End If

Found0 = Dir(FolderPath & "\" & "*" & Range("B6") & "*")

Do While Filename = Found0
   count = count + 1
   Filename = Dir()
Loop

If count = 6 Then
    Range("C6").Interior.ColorIndex = 4
Else
    Range("C6").Interior.ColorIndex = 3
End If

Range("C6").Value = count

1 Ответ

0 голосов
/ 08 июля 2019

Дайте этому попытку

Sub Test_CountFiles_UDF()
CountFiles ThisWorkbook.Path & "\MyFolder\", "xls*,doc*"
Debug.Print "--------"
CountFiles ThisWorkbook.Path & "\MyFolder\", "xls*,doc*", "finance"
End Sub

Sub CountFiles(sPath As String, sExtensions As String, Optional sFindText As String)
Dim arrTypes, strFile As String, i As Long, c As Long

arrTypes = Split(sExtensions, ",")

For i = 0 To UBound(arrTypes)
    c = 0
    strFile = Dir(sPath & "*." & arrTypes(i))

    Do While strFile <> ""
        If Not IsMissing(sFindText) And sFindText <> "" Then
            If InStr(LCase(strFile), LCase(sFindText)) Then c = c + 1
        Else
            c = c + 1
        End If

        strFile = Dir
    Loop

    Debug.Print arrTypes(i) & ": " & c
Next i
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...