1 (изменено: UstasBy, 2022-03-15 12:21:43)

Тема: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

День добрый. Имеется каталог (к примеру - "E:\- QW -\"). В нем насыпано много файлов .xls / .xlsx / .xlsm. Требуется производить обновление этих данных - по сути - открыть (при открытии макросы и запросы отработают) и сохранить. Но есть нюансы - первыми нужно открыть и сохранить несколько определенных файлов; затем все остальные в директории (там их много); но есть те, которые трогать не нужно. В подкаталоги глубже лезть не требуется. Нарисовал примерно следующее.

"Конструкция" несмотря на корявость частично отрабатывает, но почему-то строка "If FileName <> "PC.xls;PC.xlsx;QR1.xlsm;QR2.xlsm;QR3.xlsm" Then" не отрабатывает по исключениям - они все равно запускаются. Как это можно поправить и как в первой части где обрабаотываются файлы QR1.xlsm / QR2.xlsm / QR3.xlsm указать перечисление... Спасибо.

... или как вариант - брать список отрабатываемых во второй части - из внешнего текстового файла либо...


set App = CreateObject("Excel.Application")
App.visible = true
App.Workbooks.Open("E:\- QW -\QR1.xlsm")
App.ActiveWorkbook.Save
App.Workbooks.Close
App.quit

set App = CreateObject("Excel.Application")
App.visible = true
App.Workbooks.Open("E:\- QW -\QR2.xlsm")
App.ActiveWorkbook.Save
App.Workbooks.Close
App.quit

set App = CreateObject("Excel.Application")
App.visible = true
App.Workbooks.Open("E:\- QW -\QR3.xlsm")
App.ActiveWorkbook.Save
App.Workbooks.Close
App.quit

strTempPath = "E:\- QW -"
Set objFSO=CreateObject("Scripting.FileSystemObject") 
Set objFolder=objFSO.GetFolder(strTempPath) 

For Each objFile In objFolder.Files 
Ext = Mid(objFile, InstrRev(objFile, ".") + 1)
 
If FileName <> "PC.xls;PC.xlsx;QR1.xlsm;QR2.xlsm;QR3.xlsm" Then 
set App = CreateObject("Excel.Application")
App.visible = true
App.Workbooks.Open objFile
App.ActiveWorkbook.Save
App.Workbooks.Close
App.quit
End If
Next

2

Re: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

UstasBy, добрый день.
Я немного переписал, по своему вкусу.
Тщательно не тестировал.

On Error GoTo 0

' Рабочая папка
strTempPath = "E:\- QW -"

' Открываются первыми
strOpenFirst = "QR1.xlsm;QR2.xlsm;QR3.xlsm"
' Исключения - не открываются
strOpenNever = "PC.xls;PC.xlsx"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strTempPath) 
Set objApp = CreateObject("Excel.Application")
objApp.Visible = True

' 1 шаг - обрабатываем файлы из strOpenFirst
' 2 шаг - обрабатываем все остальные файлы (кроме strOpenNever)
For iStep = 1 To 2

	For Each objFile In objFolder.Files ' objFile = "E:\- QW -\qr1.xlsm"
	    
		strFile = objFile.Name ' strFile = "QR1.xlsm"
		Ext = objFSO.GetExtensionName(objFile) ' Ext = "xlsm"

		' Если расширение = xls*
		If UBound(Filter(Array("xls"), Left(Ext, 3), True, vbTextCompare)) >= 0 Then 

			' blnProcess = True, если файл из списка strOpenFirst
			blnProcess = (UBound(Filter(Split(strOpenFirst, ";"), strFile, True, vbTextCompare)) >= 0)
		
			If iStep = 2 Then

				If blnProcess Then
					' На 2-м шаге не обрабатываем файл из списка strOpenFirst
					blnProcess = False
				Else
					If UBound(Filter(Split(strOpenNever, ";"), strFile, True, vbTextCompare)) >= 0 Then
						' Не обрабатываем файл из списка strOpenNever
						WScript.Echo "Файл", strFile, "не обработан."
					Else
						blnProcess = True
					End If
				End If

			End If

			If blnProcess Then

				dOldDate = objFSO.GetFile(objFile).DateLastModified
				With objApp.Workbooks.Open(objFile)
					' Открыли-закрыли, с сохранением.
					.Close True 'SaveChanges = True
				End With
				dNewDate = objFSO.GetFile(objFile).DateLastModified
				WScript.Echo "Файл", strFile, "модифицирован:", dOldDate, "=>", dNewDate
		
			End If

		End If

	Next 'objFile

Next 'iStep

objApp.Quit

Set objFSO = Nothing
Set objFolder = Nothing
Set objApp = Nothing

WScript.Quit(0)

3 (изменено: UstasBy, 2022-03-15 18:44:35)

Re: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

andypetr, спасибо. Круто!
Немного не понял вот этот фрагмент:

		' Если расширение = xls*
		If UBound(Filter(Array("xls"), Left(Ext, 3), True, vbTextCompare)) >= 0 Then 

Не понял про расширение. Расширения в списке первой очереди strOpenFirst, ровно как и в strOpenNever и в остальных документах могут быть быть разные из экселевских - xlsm, xlsx или xls. Файлы в списках  strOpenFirst и strOpenNever меняться будут редко и я вручную откорректирую по мере надобности...
Или Array("xls") и значит что расширение будет любое из экселевских (как в комментарии xls*) ?

4

Re: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

Данное условие "фильтрует" все файлы в рабочей папке, оставляя только Экселевские.
Я поленился и, отрезая 3 левых символа расширения: Left(Ext, 3), проверяю на начало расширения: "xls".
Можно перечислить все доступные расширения в массиве (уже без обрезания расширения): Array("xls", "xlsm", "xlsb").
Сегодня не за компом уже, завтра подробнее могу написать, если надо.

5

Re: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

andypetr
Спасибо большое. Проверил - отрабатывает отлично. Еще вопрос - окно, выведенное WScript.Echo по истечение нескольких секунд как то закрывать можно? Не нашел такой возможности.
Или просто вместо этого - выводить в лог.
Если нет - просто закомментирую строки. Спасибо...

6

Re: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

UstasBy, на здоровье.
Вывод на экран консоли:

cscript //nologo script.vbs

Вывод в лог-файл (имя можно задавать произвольное):

cscript //nologo script.vbs >> test.log

Ещё мне лично не нравится objApp.Visible = True (и окно Экселя мелькает), я бы присвоил False.

7

Re: VBS: Обработка всех файлов XLS в каталоге кроме списка исключений.

andypetr пишет:

objApp.Visible = True (и окно Экселя мелькает), я бы присвоил False

Это само собой - для дебага True т.к. ряд документов нужно поправить в плане совместимости и они дополнительные сообщения выкидывают. Все отрабатывает. Спасибо большое