Sub docs_monitor()
PapkaNet$ = "\\123\2_На верстку\"
For I = 1 To 500
With Application.FileSearch
.NewSearch
.SearchSubFolders = False
.LookIn = PapkaNet$
.FileName = "*.doc"
'''If .Execute > 0 Then Call IsDocs: Exit Sub - рабочая строка
If .Execute > 0 Then MsgBox "Появился док!": Exit Sub --отладочная строка
End With
If Application.Wait(Now + TimeValue("0:00:20")) Then GoTo nexx
nexx:
Next I
End Sub
Мониторинг наличия файлов
В некоторой сетевой папке появляются файлы, которые надо забирать в обработку.
Чтобы не смотреть "руками" каждые 5 мин написал так:
1-й вопрос. Не будет ли такая проверка сильно грузить машину, может быть есть какое-то более красивое решение? (смогу проверить только в выходные. Причем предполагается, что пока документов нет, хочется что-то поделать на компе, типа посмотреть фильм или подвигать пасьянс).
2-й вопрос (более важный).
Если файл(ы) в папке появились, то надо запускать обработку (в данном сл. мою процедуру "IsDocs"), но только в случае, если в программе верстки не открыт ни один документ (т.к. не надо наваливать один док. на другой, не сверстав первый).
Условие [COLOR="Navy"]If Tasks.Exists("Adobe PageMaker 7.0") Then[/COLOR] не годится, т.к. будет всегда верно, даже если ни один док. в этой программе не открыт. А закрывать всю программу не хочется, т.к. грузится она достаточно долго. Да и не оч. это "красиво". Вот можно ли чем-то проверить, открыт ли какой-то документ или не открыт?
Все документы, которые могут быть открыты, находятся в папке D:\Tiraz\ (если это поможет как-то, например для DocPath или что-то в этом роде).
Спасибо.
Чтобы не смотреть "руками" каждые 5 мин написал так:
Код:
1-й вопрос. Не будет ли такая проверка сильно грузить машину, может быть есть какое-то более красивое решение? (смогу проверить только в выходные. Причем предполагается, что пока документов нет, хочется что-то поделать на компе, типа посмотреть фильм или подвигать пасьянс).
2-й вопрос (более важный).
Если файл(ы) в папке появились, то надо запускать обработку (в данном сл. мою процедуру "IsDocs"), но только в случае, если в программе верстки не открыт ни один документ (т.к. не надо наваливать один док. на другой, не сверстав первый).
Условие [COLOR="Navy"]If Tasks.Exists("Adobe PageMaker 7.0") Then[/COLOR] не годится, т.к. будет всегда верно, даже если ни один док. в этой программе не открыт. А закрывать всю программу не хочется, т.к. грузится она достаточно долго. Да и не оч. это "красиво". Вот можно ли чем-то проверить, открыт ли какой-то документ или не открыт?
Все документы, которые могут быть открыты, находятся в папке D:\Tiraz\ (если это поможет как-то, например для DocPath или что-то в этом роде).
Спасибо.
Могу помочь только с 1м вопросом.Для начала,правда,неплохо было бы поискать по форуму–он уж не раз обсуждался.А так…FindFirstChangeNotification/FindNextChangeNotification/FindCloseChangeNotification,ReadDirectoryChangesW вам в помощь
Dmitry2064, в принципе, Ваша задача решаема в полном объёме и при этом относительно несложно с помощью WMI, но при условии, что объектная модель [color=darkblue]PageMaker 7.0[/color] позволяет посчитать кол-во открытых в приложении документов или окон.
В качестве оценочного примера привожу VB-сценарий решения подобной задачи для [color=darkblue]Excel[/color]:
В качестве оценочного примера привожу VB-сценарий решения подобной задачи для [color=darkblue]Excel[/color]:
Код:
Dim strFile, strTemp, intDelimPos, intLen, intCount
Dim objWMI, objCollection, objEvent, objFS, objApp
Const strSourceDirWMI = "Z:\\\\Общая_папка"
Const strSourceDir = "Z:\Общая_папка\"
'On Error Resume Next
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strSourceDir) Then
WScript.Echo "Поехали."
Set objApp = GetObject(,"Excel.Application")
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objCollection = objWMI.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 20 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' AND " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
Do
Set objEvent = objCollection.NextEvent
strTemp = objEvent.TargetInstance.PartComponent
intDelimPos = InStrRev(strTemp, "\")
intLen = Len(Mid(strTemp, intDelimPos + 1)) - 1
strFile = Mid(strTemp, intDelimPos + 1, intLen)
If StrComp(objFS.GetExtensionName(strFile), "xls", vbTextCompare) = 0 Then
intCount = objApp.Workbooks.Count
If intCount = 0 Then
objApp.Workbooks.Open strSourceDir & strFile
WScript.Echo "Принят к обработке документ " & UCase(strFile)
Else
WScript.Echo "Кол-во открытых книг: " & intCount
End If
Else
WScript.Echo strFile
End If
'Exit Do
Loop
Set objEvent = Nothing
Set objCollection = Nothing
Set objWMI = Nothing
Set objApp = Nothing
End If
Set objFS = Nothing
WScript.Quit 0
Dim objWMI, objCollection, objEvent, objFS, objApp
Const strSourceDirWMI = "Z:\\\\Общая_папка"
Const strSourceDir = "Z:\Общая_папка\"
'On Error Resume Next
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strSourceDir) Then
WScript.Echo "Поехали."
Set objApp = GetObject(,"Excel.Application")
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objCollection = objWMI.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 20 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' AND " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSourceDirWMI & """'")
Do
Set objEvent = objCollection.NextEvent
strTemp = objEvent.TargetInstance.PartComponent
intDelimPos = InStrRev(strTemp, "\")
intLen = Len(Mid(strTemp, intDelimPos + 1)) - 1
strFile = Mid(strTemp, intDelimPos + 1, intLen)
If StrComp(objFS.GetExtensionName(strFile), "xls", vbTextCompare) = 0 Then
intCount = objApp.Workbooks.Count
If intCount = 0 Then
objApp.Workbooks.Open strSourceDir & strFile
WScript.Echo "Принят к обработке документ " & UCase(strFile)
Else
WScript.Echo "Кол-во открытых книг: " & intCount
End If
Else
WScript.Echo strFile
End If
'Exit Do
Loop
Set objEvent = Nothing
Set objCollection = Nothing
Set objWMI = Nothing
Set objApp = Nothing
End If
Set objFS = Nothing
WScript.Quit 0
На строку
[COLOR="DarkRed"]Set objApp = GetObject(,"PageMaker.Application")[/COLOR]
пишет
ActiveX component can't create object
Видимо, придется менять Page на Indesign (со временем).
[COLOR="DarkRed"]Set objApp = GetObject(,"PageMaker.Application")[/COLOR]
пишет
ActiveX component can't create object
Видимо, придется менять Page на Indesign (со временем).