Наличие файлов в папке с внесением данных табл Эксель

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Наличие файлов в папке с внесением данных табл Эксель (Макросы/Sub)

CDorian18092044

Дата: Четверг, 07.12.2017, 18:50 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

[font=Arial][color=black]Приветствую всех форумчан! Помогите в решении, пожалуйста!
Есть большой (9000 поз) список оборудования. На каждое оборудование создана папка и ее номер указан в первой графе. Все папки на диске D:\Оборудование\*********, где ******** номер папки. Ячейка с номером папки имеет гиперссылку на свою папку. Необходим макрос позволяющий проверить наличие в папке документов размером более 200КБ и по итогам проверки окрашивающий ячейку красный при отсутствии или зеленый при наличии документов более указанного размера. Макрос будет запускаться вручную каждый день для проверки наполняемости папок (ежедневно дополняются папки документами).
Сам создал макрос на ответ "да" или "нет", но он виснет и не дает результата и про цвет и размер не соображу. Поправьте меня пожалуйста!!! Код ниже и файл в приложении :'(

[vba]

Код

Sub Module5()
Dim i&, pathf$
Dim strPos As String
strPos = CActivCel
pathf = "D:\Оборудование\"
i_n& = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To i_n
If Cells(i, 1) <> "" Then
    If dir(pathf & strPos & "\" & "*.*") <> "" Then
            Cells(i, 2) = "Да"
    Else
            Cells(i, 2) = "Нет"[font=Arial]
End If
End Sub

[/vba]

CDorian18092044

Ответить

Manyasha

Дата: Четверг, 07.12.2017, 21:23 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 898 ±

Замечаний: 0% ±

Excel 2010, 2016

CDorian18092044, файл не приложился, проверьте размер, д.б. не больше 100 кб.

Цитата CDorian18092044, 07.12.2017 в 18:50, в сообщении № 1 ()

он виснет и не дает результата

Виснет или ошибку выдает? У Вас цикл не закрыт и один if.

ЯД: 410013299366744 WM: R193491431804

Ответить

CDorian18092044

Дата: Пятница, 08.12.2017, 12:02 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Manyasha,
Добрый день!
Выдает ошибку. В коде уже поправил If и закрыл Next.
Попробовал еще так
[vba]

Код

Sub Module5()
Dim i&, pathf$
Dim strPos As String
Dim strFileName As String
strFileName = "12.pdf"
pathf = "D:\Оборудование\"
i_n& = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To i_n
strPos = CActivCell
If Cells(i, 1) <> "" Then
    If dir(pathf & strPos & "\" & strFileName) <> "" Then
            Cells(i, 2) = "ДА"
    Else
            Cells(i, 2) = "Нет"
    End If
End If
Next
End Sub

[/vba]
Результат тот же.

К сообщению приложен файл: ____.xls (41.5 Kb)

CDorian18092044

Ответить

CDorian18092044

Дата: Пятница, 08.12.2017, 12:06 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

CDorian18092044, в папке реально положил файл 12. pdf 40 КБ. В остальных пусто.

CDorian18092044

Ответить

SLAVICK

Дата: Пятница, 08.12.2017, 13:09 | Сообщение № 5

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Может так?
[vba]

Код

Sub Module5()
Dim i&, pathf$
Dim strPos As String
Dim strFileName As String
strFileName = "12.pdf"
pathf = "D:\Оборудование\"
i_n& = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To i_n
'strPos = CActivCell
If Cells(i, 1) <> "" Then
    If Dir(pathf & Cells(i, 1) & "\" & strFileName) <> "" Then
            Cells(i, 2) = "ДА"
    Else
            Cells(i, 2) = "Нет"
    End If
End If
Next
End Sub

[/vba]
Не понятно что Вы хотели сказать строкой:
[vba]

Код

strPos = CActivCell

[/vba]

Иногда все проще чем кажется с первого взгляда.

Ответить

CDorian18092044

Дата: Пятница, 08.12.2017, 15:16 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Спасибо!
Сам дошел до
[vba]

Код

strPos = Cells(i, 1)

[/vba]
А предполагал, что
[vba]

Код

strPos = CActivCell

[/vba]
даст ссылку на активную ячейку и из нее начнется макрос. Затупилллллл!

Все заработало!!! Спасибо! hands

Теперь бы как-то попробовать решить вопрос о проверки не просто наличия файлов в папке, а наличия в ней файлов размером свыше 300КБ.
Получилось у меня покрасить ячейки в красный и зеленый цвет в зависимости от наполнения папки.
Для интересующихся размещаю что получилось
[vba]

Код

Sub
Dim i&, pathf$
Dim strPos As String
Dim strFileName As String
strFileName = "*.*"
pathf = "D:\Оборудование\"
i_n& = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To i_n
strPos = Cells(i, 1)
If Cells(i, 1) <> "" Then
    If dir(pathf & strPos & "\" & strFileName) = "" Then
           Cells(i, 1).Select
           With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
            Else
           Cells(i, 1).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
    End If
End If
Next
End Sub

[/vba]
Посоветуйте кто может - как проверить размер файла! Спасибо!