• Сканирование в 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

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

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


    Примечание - Вы можете использовать эти 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>

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