Сканирование с помощью Twain или WIA

Sub scan()
    
    Dim objDM As WIA.DeviceManager
    'MsgBox (Split(ActiveCell.Address, "$")(1))
        Dim objDev As WIA.Device
        
            Dim objItem As WIA.Item
            Dim objImage, FirstImage As WIA.ImageFile
            Dim objIP As WIA.ImageProcess
        
        Dim s As String
        Dim i, num As Integer
      
     Set objDM = New WIA.DeviceManager
     For i = 1 To objDM.DeviceInfos.Count
        If objDM.DeviceInfos(i).Type = 1 Then
          s = objDM.DeviceInfos(i).DeviceID
        End If
     Next
     
     Set objDev = objDM.DeviceInfos(s).Connect
     If objDev Is Nothing Then
        MsgBox ("Error: Not device found")
     Else
 
        objDev.Properties("Document Handling Select").Value = 1
        objDev.Properties("Pages").Value = 1
     
        Set objItem = objDev.Items(1)
     
            Set objImage = New WIA.ImageFile
            Set objIP = New WIA.ImageProcess
            
ScanStart:
 
        On Error GoTo ScanError
            
            Set objImage = objItem.Transfer("{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}")
            num = num + 1
            If num = 1 Then
                Set FirstImage = objImage
            Else
                objIP.Filters.Add (objIP.FilterInfos("Frame").FilterID)
                objIP.Filters(objIP.Filters.Count).Properties("ImageFile") = objImage
                objIP.Filters(objIP.Filters.Count).Properties("FrameIndex") = objIP.Filters.Count
            End If
 
        GoTo ScanStart
        
ScanError:
 
        Select Case Err.Number
            Case -2145320957
                MsgBox ("No More Pages Found")
 
                objIP.Filters.Add (objIP.FilterInfos("Convert").FilterID)
                objIP.Filters(objIP.Filters.Count).Properties("FormatID") = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
                Set FirstImage = objIP.Apply(FirstImage)
                FirstImage.SaveFile "c:\test\" & ActiveCell.Value & num & ".TIFF"
            Case Else
                MsgBox ("Error: " & Err.Description & "(" & Err.Number & ")")
        End Select
        
        Set FirstImage = Nothing
        Set objItem = Nothing
        Set objImage = Nothing
        Set objDev = Nothing
     End If
     
     Set objDev = Nothing
     Set objDM = Nothing
    
End Sub