[Iska]

а нужно чтобы файл получал следующий порядковый номер. »

И было бы отлично, если скрипт определял наличие папки в папке, то есть находясь в "Z:\Отсканированные документы\" он создавал папку с сегодняшним числом, а если папка уже создана, просто сканировал бы документы сразу в неё. »

Мы сделаем иначе. Создание папки лежит на совести пользователя. Файлы получают имена по шаблону «ScanImage_YYYYMMDDHHMMSS.jpg»:

читать дальше »

Код:

Option Explicit

Const ScannerDeviceType = 1
Const ColorIntent = 1
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"


Dim objFSO

Dim objDeviceManager
Dim objDeviceInfos
Dim objDevice

Dim objImageFile
Dim objImageProcess

Dim strPath2Save
Dim strFormat
Dim intQuality
Dim intDPI
Dim intHorizontalSize
Dim intVerticalSize


' Задаём характеристики изображения
strPath2Save      = "Z:\Отсканированные документы" ' Путь к папке для сохранения
strFormat         = wiaFormatJPEG                  ' Формат файла — *.jpg
intQuality        = 80                             ' Качество jpg
intDPI            = 300                            ' Разрешение — 300 dpi
intHorizontalSize = (210 / 25.4) * intDPI          ' Размер по горизонтали — A4
intVerticalSize   = (297 / 25.4) * intDPI          ' Размер по вертикали — A4

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(strPath2Save) Then
	Set objDeviceManager = WScript.CreateObject("WIA.DeviceManager")
	Set objDeviceInfos = objDeviceManager.DeviceInfos
	
	If objDeviceInfos.Count > 0 Then
		' Выбираем устройство для сканирования. Если оно единственное, то сие произойдёт без отображения диалога.
		Set objDevice = WScript.CreateObject("WIA.CommonDialog").ShowSelectDevice(ScannerDeviceType, False, False)
		
		If Not objDevice Is Nothing Then
			WScript.Echo objDevice.Properties.Item("Name") & " [" & objDevice.DeviceID & "]"
			WScript.Echo "Scanning..."
			
			With objDevice
				With .Items(1)
					' Задаём требуемые характеристики изображения для сканирования
					With .Properties
						.Item("6146").Value = ColorIntent             ' Цветовая модель (Current Intent)
						
						' Разрешение…
						.Item("6147").Value = intDPI                  ' …по горизонтали (Horizontal Resolution)
						.Item("6148").Value = intDPI                  ' …по вертикали (Vertical Resolution)
						
						' Начало области сканирования…
						.Item("6149").Value = 0                       ' …по горизонтали (Horizontal Start Position)
						.Item("6150").Value = 0                       ' …по вертикали (Vertical Start Position)
						
						' Размер области сканирования…
						.Item("6151").Value = intHorizontalSize       ' …по горизонтали (Horizontal Extent)
						.Item("6152").Value = intVerticalSize         ' …по вертикали (Vertical Extent)
					End With
					
					' Инициируем начало операции сканирования
					Set objImageFile = .Transfer()
					
					' Конвертируем полученное изображение
					WScript.Echo "Converting..."
					
					Set objImageProcess = WScript.CreateObject("WIA.ImageProcess")
					
					With objImageProcess
						With .Filters
							.Add objImageProcess.FilterInfos("Convert").FilterID
							
							With .Item(1).Properties
								.Item("FormatID").Value = strFormat  ' Формат изображения
								.Item("Quality").Value  = intQuality ' Качество изображения
							End With
						End With
						
						Set objImageFile = .Apply(objImageFile)
					End With
				End With
			End With
			
			' Сохраняем полученное изображение
			objImageFile.SaveFile objFSO.BuildPath(strPath2Save, "ScanImage_" & FormatLocalDateTime() & ".jpg")
			
			WScript.Echo "Complete."
			
			Set objDevice = Nothing
		Else
			WScript.Echo "Cancel scanning by user"
		End If
	Else
		WScript.Echo "No connected devices"
	End If
	
	Set objDeviceManager = Nothing
	Set objDeviceInfos   = Nothing
Else
	WScript.Echo "Папка для сохранения результатов сканирования [" & strPath2Save & "] не найдена."
	WScript.Quit 1
End If

Set objFSO = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Function FormatLocalDateTime()
	Dim objSWbemObjectEx
	
	For Each objSWbemObjectEx In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("SELECT LocalDateTime FROM Win32_OperatingSystem")
		FormatLocalDateTime = Left(objSWbemObjectEx.LocalDateTime, 8 + 6)
		
		Exit For
	Next
End Function
'=============================================================================

[magnum888]

Спасибо, файлы теперь не перезаписываются, но в названии файла получается следующее "ScanImage_20140401084424.jpg", как изменить функцию, чтобы было хоть какое-то разделение между числами, и если можно, оставить только время.

[Iska]

В таком виде: «ScanImage_20140401_084424.jpg» — устроит?

и если можно, оставить только время. »

Не стоит. Не надейтесь, что Вы никогда не наткнётесь на дублирование, если оставите только время. Даже нынешний вариант гож только для сканирования с одного рабочего места, а с нескольких — опять же могут появиться дубликаты.

[magnum888]

В таком виде: «ScanImage_20140401_084424.jpg» — устроит? »

Дату хотелось бы убрать за ненадобностью, лишняя информация, а разделители нужны, чтобы можно было легко разобрать время когда было совершенно сканирование. В названии я убрал "ScanImage" осталась дата и время.

[Iska]

Дату хотелось бы убрать за ненадобностью, лишняя информация, »

Не лишняя. Как пару-тройку раз наткнётесь на ошибку времени исполнения при дублировании имён — передумаете. Городить же огород с подсчётом существующего количества файлов, да учитывать наличие возможных пропусков в нумерации после удаления — вот это действительно в данном случае лишнее.

а разделители нужны, чтобы можно было легко разобрать время когда было совершенно сканирование »

Я и так более чем отчётливо вижу — в «8:44:24». А Вы? О двоеточии в качестве разделителя точно забудьте — данный символ недопустим в именах файлов.

Кстати, дата и время превосходно смотрятся в свойствах файла. В имени же дата/время у нас используются а) для исключения дублирования имён и б) для корректной сортировки в Проводнике. Не более.

Пробуйте:

читать дальше »

Код:

Option Explicit

Const ScannerDeviceType = 1
Const ColorIntent = 1
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"


Dim objFSO

Dim objDeviceManager
Dim objDeviceInfos
Dim objDevice

Dim objImageFile
Dim objImageProcess

Dim strPath2Save
Dim strFormat
Dim intQuality
Dim intDPI
Dim intHorizontalSize
Dim intVerticalSize


' Задаём характеристики изображения
strPath2Save      = "Z:\Отсканированные документы" ' Путь к папке для сохранения
strFormat         = wiaFormatJPEG                  ' Формат файла — *.jpg
intQuality        = 80                             ' Качество jpg
intDPI            = 300                            ' Разрешение — 300 dpi
intHorizontalSize = (210 / 25.4) * intDPI          ' Размер по горизонтали — A4
intVerticalSize   = (297 / 25.4) * intDPI          ' Размер по вертикали — A4

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(strPath2Save) Then
	Set objDeviceManager = WScript.CreateObject("WIA.DeviceManager")
	Set objDeviceInfos = objDeviceManager.DeviceInfos
	
	If objDeviceInfos.Count > 0 Then
		' Выбираем устройство для сканирования. Если оно единственное, то сие произойдёт без отображения диалога.
		Set objDevice = WScript.CreateObject("WIA.CommonDialog").ShowSelectDevice(ScannerDeviceType, False, False)
		
		If Not objDevice Is Nothing Then
			WScript.Echo objDevice.Properties.Item("Name") & " [" & objDevice.DeviceID & "]"
			WScript.Echo "Scanning..."
			
			With objDevice
				With .Items(1)
					' Задаём требуемые характеристики изображения для сканирования
					With .Properties
						.Item("6146").Value = ColorIntent             ' Цветовая модель (Current Intent)
						
						' Разрешение…
						.Item("6147").Value = intDPI                  ' …по горизонтали (Horizontal Resolution)
						.Item("6148").Value = intDPI                  ' …по вертикали (Vertical Resolution)
						
						' Начало области сканирования…
						.Item("6149").Value = 0                       ' …по горизонтали (Horizontal Start Position)
						.Item("6150").Value = 0                       ' …по вертикали (Vertical Start Position)
						
						' Размер области сканирования…
						.Item("6151").Value = intHorizontalSize       ' …по горизонтали (Horizontal Extent)
						.Item("6152").Value = intVerticalSize         ' …по вертикали (Vertical Extent)
					End With
					
					' Инициируем начало операции сканирования
					Set objImageFile = .Transfer()
					
					' Конвертируем полученное изображение
					WScript.Echo "Converting..."
					
					Set objImageProcess = WScript.CreateObject("WIA.ImageProcess")
					
					With objImageProcess
						With .Filters
							.Add objImageProcess.FilterInfos("Convert").FilterID
							
							With .Item(1).Properties
								.Item("FormatID").Value = strFormat  ' Формат изображения
								.Item("Quality").Value  = intQuality ' Качество изображения
							End With
						End With
						
						Set objImageFile = .Apply(objImageFile)
					End With
				End With
			End With
			
			' Сохраняем полученное изображение
			objImageFile.SaveFile objFSO.BuildPath(strPath2Save, FormatLocalDateTime() & ".jpg")
			
			WScript.Echo "Complete."
			
			Set objDevice = Nothing
		Else
			WScript.Echo "Cancel scanning by user"
		End If
	Else
		WScript.Echo "No connected devices"
	End If
	
	Set objDeviceManager = Nothing
	Set objDeviceInfos   = Nothing
Else
	WScript.Echo "Папка для сохранения результатов сканирования [" & strPath2Save & "] не найдена."
	WScript.Quit 1
End If

Set objFSO = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Function FormatLocalDateTime()
	Dim objSWbemObjectEx
	
	For Each objSWbemObjectEx In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("SELECT LocalDateTime FROM Win32_OperatingSystem")
		FormatLocalDateTime = Left(objSWbemObjectEx.LocalDateTime, 8) & "_" & Mid(objSWbemObjectEx.LocalDateTime, 9, 6)
		
		Exit For
	Next
End Function
'=============================================================================

[Hitch]

Скрипт рабочий. Спасибо, выручили!