Сканирование в Microsoft Office 2013

После публикации статьи Сканирование и MS Office 2010 я получил много положительных отзывов о этой фишке. Но после Выхода в свет MS Office 2013, оказалось, что в новой версии офиса, старые скрипты не работают. Ну ни чего страшного я нашел еще один. После небольшой настройки можно будет запускать мастер сканирования в Word и удобно сканировать документ))). Наглядно, как это работает, можно посмотреть на видео:

Теперь перейдем к подробностям.

Создаем как и раньше кнопку со скриптом, а внутрь помещаем код:

Option Explicit

Public Declare Function SHGetSpecialFolderLocation _
Lib "shell32" (ByVal hwnd As Long, _
ByVal nFolder As Long, ppidl As Long) As Long

Public Declare Function SHGetPathFromIDList _
Lib "shell32" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)

Public Const CSIDL_LOCAL_APPDATA = &H1C '<user name>\Local Settings\Application Data
Public Const MAX_PATH = 260
Public Const NOERROR = 0


Public Function TempFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String

strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
If lngPidlFound = NOERROR Then
lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
If lngFolderFound Then
TempFolder = Left$(strPath, _
InStr(1, strPath, vbNullChar) - 1)
End If
End If
CoTaskMemFree lngPidl
End Function


Sub Scan()
'Based on a macro by Günter Born www.borncity.de blog.borncity.com
'Requires a reference to Microsoft Windows Image Acquisition Object Library
' On Error Resume Next
Dim objCommonDialog As WIA.CommonDialog
Dim objImage As WIA.ImageFile
Dim strPath As String
Set objCommonDialog = New WIA.CommonDialog
Set objImage = objCommonDialog.ShowAcquireImage
strPath = SpecFolder(&H1C) & "\Temp\TempScan.jpg" ' set temporary file location

If Not objImage Is Nothing Then
objImage.SaveFile strPath ' save into temporary file
'Insertion alternatives ++++++++++++++
Selection.InlineShapes.AddPicture strPath ' Insert in Word Document
'ActiveSheet.Pictures.Insert(strPath).Select 'Insert in Excel
'If TypeName(ActiveWindow) = "Inspector" Then 'Insert into Outlook message
' If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
' ActiveInspector.WordEditor.Application.Selection.InlineShapes.AddPicture strPath
' End If
'End If
'+++++++++++++++++++++++++++++++++++++
Set objImage = Nothing
End If
If Not Dir(strPath) = vbNullString Then Kill strPath 'Remove the temporary file
Set objCommonDialog = Nothing
End Sub


Public Function SpecFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String

strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
If lngPidlFound = NOERROR Then
lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
If lngFolderFound Then
SpecFolder = Left$(strPath, _
InStr(1, strPath, vbNullChar) - 1)
End If
End If
CoTaskMemFree lngPidl
End Function

Есть один нюанс, в редакторе VB необходимо добавить библиотеку Microsoft Windows Image Acquisition object к скрипту. Как это сделать показано на видео.

По моему этот метод гораздо лучше предыдущего)

Будут вопросы пишите!

Оставите комментарий ?

14 Комментарии。

  1. Сканирование и MS Office 2010 | sysrtfm - pingback on 18.12.2013 в 14:36
  2. Леонид

    не даёт выбрать сканер, сразу переходит на тот сканер, который был ранее.

    Где может быть мой косяк? в ONE NOTE при добавлении изображения со сканирования даёт на выбор 4 сканера.

    • Леонид, попробуйте удалить скрипт и повторить все заново. На 2 ПК делал (Win 7 и Win 8) Все ок было в обоих случаях.

      • Леонид

        У меня МФУ kyocera 6525. В комплекте TWIN драйверы. Скрипт выдает ошибку: Не доступно ни одно WIA-устройство выбранного типа. Поправить скрип можно?

        • Леонид, извините, но скрипт нашел у чешского админа, кое-как перевел его статью и запостил тут скрипт. И к сожалению не запомнил его адрес.. если придет в голову какая то мысль я вам напишу.

  3. Артемий Журавлев

    А как быть с 64 битными системами? У меня выдает ошибку на win7 x64.

  4. Дмитрий Назаров

    Функция SHGetSpecialFolderLocation устарела. Подправил скрипт, работает на Word 2013.

    Option Explicit

    Sub Scan()

    ‘Based on a macro by Gunter Born http://www.borncity.de blog.borncity.com
    ‘Requires a reference to Microsoft Windows Image Acquisition Object Library
    ‘ On Error Resume Next
    Dim objCommonDialog As WIA.CommonDialog
    Dim objImage As WIA.ImageFile
    Dim strPath As String
    Set objCommonDialog = New WIA.CommonDialog
    Set objImage = objCommonDialog.ShowAcquireImage
    strPath = Environ(«temp») & «TempScan.jpg» ‘ set temporary file location

    If Not objImage Is Nothing Then
    objImage.SaveFile strPath ‘ save into temporary file
    ‘Insertion alternatives ++++++++++++++
    Selection.InlineShapes.AddPicture strPath ‘ Insert in Word Document
    ‘ActiveSheet.Pictures.Insert(strPath).Select ‘Insert in Excel
    ‘If TypeName(ActiveWindow) = «Inspector» Then ‘Insert into Outlook message
    ‘ If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
    ‘ ActiveInspector.WordEditor.Application.Selection.InlineShapes.AddPicture strPath
    ‘ End If
    ‘End If
    ‘+++++++++++++++++++++++++++++++++++++
    Set objImage = Nothing
    End If
    If Not Dir(strPath) = vbNullString Then Kill strPath ‘Remove the temporary file
    Set objCommonDialog = Nothing
    End Sub

  5. Артемий Журавлев

    Хорошо было бы скрипт в нормальном виде получить, а не одной строчкой)

    Кстати вот для 2010 офиса скрипт
    Sub InsertFromScanner()
    On Error Resume Next
    WordBasic.InsertImagerScan
    End Sub

  6. Артемий Журавлев

    на винде 64 бита выдает ошибку

  7. Людмила

    что то у меня код ошибку пишет

    Public Const CSIDL_LOCAL_APPDATA = &H1C ‘\Local Settings\Application Data
    Public Const MAX_PATH = 260
    Public Const NOERROR = 0

    Помогите, что это

Ответить на djforce ¬
Отменить ответ


Примечание - Вы можете использовать эти HTML tags and attributes:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Трэкбэки и Пингбэки: