Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Наличие файлов в папке с внесением данных табл Эксель - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Наличие файлов в папке с внесением данных табл Эксель (Макросы/Sub)
Наличие файлов в папке с внесением данных табл Эксель
CDorian18092044 Дата: Четверг, 07.12.2017, 18:50 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 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
 
Ответить
Сообщение[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
Дата добавления - 07.12.2017 в 18:50
Manyasha Дата: Четверг, 07.12.2017, 21:23 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2028
Репутация: 843 ±
Замечаний: 0% ±

Excel 2010, 2016
CDorian18092044, файл не приложился, проверьте размер, д.б. не больше 100 кб.
Цитата CDorian18092044, 07.12.2017 в 18:50, в сообщении № 1 ()
он виснет и не дает результата

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


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеCDorian18092044, файл не приложился, проверьте размер, д.б. не больше 100 кб.
Цитата CDorian18092044, 07.12.2017 в 18:50, в сообщении № 1 ()
он виснет и не дает результата

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

Автор - Manyasha
Дата добавления - 07.12.2017 в 21:23
CDorian18092044 Дата: Пятница, 08.12.2017, 12:02 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 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(42Kb)


CDorian18092044
 
Ответить
Сообщение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]
Результат тот же.

Автор - CDorian18092044
Дата добавления - 08.12.2017 в 12:02
CDorian18092044 Дата: Пятница, 08.12.2017, 12:06 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

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


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

Автор - CDorian18092044
Дата добавления - 08.12.2017 в 12:06
SLAVICK Дата: Пятница, 08.12.2017, 13:09 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2028
Репутация: 697 ±
Замечаний: 0% ±

2007,2010,2013,2016
Может так?
[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]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеМожет так?
[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]

Автор - SLAVICK
Дата добавления - 08.12.2017 в 13:09
CDorian18092044 Дата: Пятница, 08.12.2017, 15:16 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 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]
Посоветуйте кто может - как проверить размер файла! Спасибо! :D


CDorian18092044
 
Ответить
СообщениеСпасибо!
Сам дошел до
[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]
Посоветуйте кто может - как проверить размер файла! Спасибо! :D

Автор - CDorian18092044
Дата добавления - 08.12.2017 в 15:16
InExSu Дата: Суббота, 09.12.2017, 23:38 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 260
Репутация: 29 ±
Замечаний: 80% ±

Excel 2010
Привет!
Цитата CDorian18092044, 08.12.2017 в 15:16, в сообщении № 6 ()
как проверить размер файла!

FileLen
 
Ответить
СообщениеПривет!
Цитата CDorian18092044, 08.12.2017 в 15:16, в сообщении № 6 ()
как проверить размер файла!

FileLen

Автор - InExSu
Дата добавления - 09.12.2017 в 23:38
CDorian18092044 Дата: Воскресенье, 10.12.2017, 14:26 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
InExSu, Спасибо! Попробую!


CDorian18092044
 
Ответить
СообщениеInExSu, Спасибо! Попробую!

Автор - CDorian18092044
Дата добавления - 10.12.2017 в 14:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Наличие файлов в папке с внесением данных табл Эксель (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!