Dim N As Integer
Dim MSG As VbMsgBoxResult
Private Sub Form_Load()
File1.Path = "..." 'это путь к папке
N = File1.ListCount
End Sub
Private Sub Timer1_Timer()
File1.Refresh
If N < File1.ListCount Then N = File1.ListCount
MSG = MsgBox("Пришёл новый документ" , , "Сообщение")
End Sub
Можно ли оповещать о появлении нового файла в директории
Что приходится делать. Я с периодичностью в 5-10 мин просматриваю некоторую сетевую папку на предмет, нет ли там нового документа для работы. Можно ли придумать какую-то систему оповещения? (Вычитал, что объектная модель [COLOR="Navy"]Microsoft WMI Scripting v1.1[/COLOR] "может выполнить какой-то код в ответ на создание или удаление файла каталоге" и т.п.)
Можно ли что-то подсказать по этому вопросу?
Спасибо.
Можно ли что-то подсказать по этому вопросу?
Спасибо.
Я бы добавил в проект, FileListBox и Timer (Timer.Interval=60000, то есть ежеминутная работа таймера, реже незя! :D ). А далее написал бы несколько строк программного кода:
Код:
Цитата: Dmitry2064
... Можно ли придумать какую-то систему оповещения? (Вычитал, что объектная модель [COLOR="Navy"]Microsoft WMI Scripting v1.1[/COLOR] "может выполнить какой-то код в ответ на создание или удаление файла каталоге" и т.п.)...
Пример:
Код:
Dim strFile, strTemp
Dim x, y
Dim objWMI, objEventsCollection, objEvent, objFS
Const strSourceDirWMI = "C:\\\\Source"
Const strSourceDir = "C:\Source\"
Const timeVal = "3"
'On Error Resume Next
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strSourceDir) Then
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objEventsCollection = objWMI.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN " & timeVal & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
Do
Set objEvent = objEventsCollection.NextEvent
strTemp = objEvent.TargetInstance.PartComponent
x = InStrRev(strTemp, "\")
y = Len(Mid(strTemp, x + 1)) - 1
strFile = Mid(strTemp, x + 1, y)
MsgBox "Появился новый файл: " & strFile, vbInformation
'Здесь можно предусмотреть процедуру выхода из бесконечного цикла
Loop
Else
MsgBox "Не обнаружен наблюдаемый каталог.", vbCritical
End If
Set objFS = Nothing
Set objEvent = Nothing
Set objEventsCollection = Nothing
Set objWMI = Nothing
Dim x, y
Dim objWMI, objEventsCollection, objEvent, objFS
Const strSourceDirWMI = "C:\\\\Source"
Const strSourceDir = "C:\Source\"
Const timeVal = "3"
'On Error Resume Next
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strSourceDir) Then
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objEventsCollection = objWMI.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN " & timeVal & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
Do
Set objEvent = objEventsCollection.NextEvent
strTemp = objEvent.TargetInstance.PartComponent
x = InStrRev(strTemp, "\")
y = Len(Mid(strTemp, x + 1)) - 1
strFile = Mid(strTemp, x + 1, y)
MsgBox "Появился новый файл: " & strFile, vbInformation
'Здесь можно предусмотреть процедуру выхода из бесконечного цикла
Loop
Else
MsgBox "Не обнаружен наблюдаемый каталог.", vbCritical
End If
Set objFS = Nothing
Set objEvent = Nothing
Set objEventsCollection = Nothing
Set objWMI = Nothing
На эту инструкцию
пишет, "Run-time error (c номерами). Неразбираемый запрос".
Теперь. Залез в help в VBA из Ворда и по слову Refresh (спасибо SPB-667) нашел такой примерчик:
VBA пишет, что надо добавить этот док. в "рабочую область". Тогда я взял новый пример из Хелпа, где док. добавляют в рабочую область.
Теперь пишется, что [COLOR="DarkRed"]"Выбранное размещение раб. области расположено в области ограниченных или ненадежных узлов. Если уверены, то добавьте его в область надежных узлов и попробуйте снова создать рабочую область"[/COLOR]
Стал добавлять через IE, а оно опять ругается.
Т.е. уже залезаю в дебри.
А нельзя ли как-то с помощью "Dir" - и периодически считать там кол-во файлов?
Код:
Set objEventsCollection = objWMI.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN " & timeVal & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
("SELECT * FROM __InstanceCreationEvent WITHIN " & timeVal & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
пишет, "Run-time error (c номерами). Неразбираемый запрос".
Теперь. Залез в help в VBA из Ворда и по слову Refresh (спасибо SPB-667) нашел такой примерчик:
Код:
Sub FileWatch() [COLOR="Green"]'это моя строчка, а между Sub и End Sub строчки примера из хелпа[/COLOR]
Dim swsFiles As Office.SharedWorkspaceFiles
Set swsFiles = ActiveDocument.SharedWorkspace.Files
MsgBox "There are " & swsFiles.Count & " file(s)", vbInformation, vbOKOnly, "Collection Information"
Set swsFiles = Nothing
End Sub[COLOR="Green"]'и это моя строчка[/COLOR]
Dim swsFiles As Office.SharedWorkspaceFiles
Set swsFiles = ActiveDocument.SharedWorkspace.Files
MsgBox "There are " & swsFiles.Count & " file(s)", vbInformation, vbOKOnly, "Collection Information"
Set swsFiles = Nothing
End Sub[COLOR="Green"]'и это моя строчка[/COLOR]
VBA пишет, что надо добавить этот док. в "рабочую область". Тогда я взял новый пример из Хелпа, где док. добавляют в рабочую область.
Теперь пишется, что [COLOR="DarkRed"]"Выбранное размещение раб. области расположено в области ограниченных или ненадежных узлов. Если уверены, то добавьте его в область надежных узлов и попробуйте снова создать рабочую область"[/COLOR]
Стал добавлять через IE, а оно опять ругается.
Т.е. уже залезаю в дебри.
А нельзя ли как-то с помощью "Dir" - и периодически считать там кол-во файлов?
Вот если бы выполнять такой в автоматич. режиме с нек. периодичностью:
Как count стал больше, так вперед. Может быть можно подписать сюда какой-то счетчик минут на 5-10, чтобы процессор не грузить, но в тоже время, что бы эта программка могла висеть в памяти и "watch'ить".
Код:
Sub FileWatch()
iPath = "D:\123\456\Docs\"
iFileName$ = Dir(iPath & "*.doc")
Do While iFileName <> ""
Count = Count + 1
iFileName = Dir
Loop
замедлитель-таймер как-нить
Call FileWatch() 'опять
End sub
iPath = "D:\123\456\Docs\"
iFileName$ = Dir(iPath & "*.doc")
Do While iFileName <> ""
Count = Count + 1
iFileName = Dir
Loop
замедлитель-таймер как-нить
Call FileWatch() 'опять
End sub
Как count стал больше, так вперед. Может быть можно подписать сюда какой-то счетчик минут на 5-10, чтобы процессор не грузить, но в тоже время, что бы эта программка могла висеть в памяти и "watch'ить".
Вот ещё пример, как посчитать файлы в папке
А вы работаете в Visual Basic'e или в VBA (под Офисом) ? Если просто в VB может можно на форму положить таймер?
Код:
Sub CountFiles()
Dim objFSO, objFolder, i&
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Temp\")
i = objFolder.Files.Count
MsgBox "Количество файлов: " & i
End Sub
Dim objFSO, objFolder, i&
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Temp\")
i = objFolder.Files.Count
MsgBox "Количество файлов: " & i
End Sub
А вы работаете в Visual Basic'e или в VBA (под Офисом) ? Если просто в VB может можно на форму положить таймер?
Цитата: Dmitry2064
На эту инструкцию
пишет, "Run-time error (c номерами). Неразбираемый запрос".
Код:
Set objEventsCollection = objWMI.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN " & timeVal & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
("SELECT * FROM __InstanceCreationEvent WITHIN " & timeVal & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
пишет, "Run-time error (c номерами). Неразбираемый запрос".
Такая ошибка могла возникнуть из-за неверного задания значения консанты strSourceDirWMI, а именно: в каком-то месте строки стоит нечётное количество символов "\".
Если путь к сетевой папке задаётся, например, строкой: "X:\Folder\Subfolder", то strSourceDirWMI = "X:\\\\Folder\\\\Subfolder" (то есть для использования в таком WMI-запросе каждый символ "\", стоящий в пути к папке, надо учетверять).
Забыл сразу сделать два примечания:
- код примера представляет собой VB-сценарий, поэтому для использования его в составе макроса или программы в конец или начало тела цикла надо добавить вызов функции [color=blue]DoEvents[/color];
- для нормальной работы сценария наблюдаемую сетевую папку лучше подключить как сетевой диск, т.к. (по непонятной мне причине) использование UNC-пути делает код неработоспособным, хотя ошибки и не вызывает.
Цитата: Dmitrii
каждый символ "\", стоящий в пути к папке, надо учетверять).
Понял.
Цитата: Dmitrii
Забыл сразу сделать два примечания:
- ...надо добавить вызов функции [color=blue]DoEvents[/color];
- ... лучше подключить как сетевой диск, т.к. (по непонятной мне причине) использование UNC-пути делает код неработоспособным, хотя ошибки и не вызывает.
С DoEvents - это мне надо еще сообразить. Про сетевое подключение понял. Спасибо.
Цитата: pavel55
А вы работаете в Visual Basic'e или в VBA (под Офисом) ? Если просто в VB может можно на форму положить таймер?
Вообще-то в VBA, но может имеет смысл как раз сделать на VB следящуюю программку, чтобы висела и оповещала (если не будет слишком кушать ресурсы). А про timer мне как раз и SPB-667 посоветовал. Надо попробовать.
Спасибо большое.
Цитата: SPB-667
Я бы добавил в проект, FileListBox и Timer (Timer.Interval=60000, то есть ежеминутная работа таймера, реже незя! :D ). А далее написал бы несколько строк программного кода:
На File1.ListCount говорит, что "требуется объект". Не пойму, как его вписать надо. А FileListBox поставил на форму. И Таймер. Т.е. как бы работает, но наполовину. Т.е. просто говорит каждую минуту, что файлов столько-то. Без рефреша никак. А рефреш без File1 тоже никак. Поэтому остановился. :o
Так это все есть в стандартных компонентах, посмотри в тулбоксе повнимательней.
А вообще - тебе поможет FindFirstChangeNotification
А вообще - тебе поможет FindFirstChangeNotification
Цитата: Dmitry2064
С DoEvents - это мне надо еще сообразить.
Посмотрите вот эту тему (там обсуждался подобный вопрос): Цикл в папке
Всем спасибо. В субботу начну разбираться. :)