代码之家  ›  专栏  ›  技术社区  ›  mwolfe02

WIA文档处理状态返回0,即使ADF已加载页

  •  2
  • mwolfe02  · 技术社区  · 15 年前

    我正在尝试使用VBA和Windows图像采集库(WIA)从ADF扫描。我正在检查ADF中是否加载了页面,以便知道是否扫描其他页面。此功能在Windows 7(我的开发人员计算机)中似乎工作得很好,但在Windows XP(生产计算机)中似乎不工作。我知道微软在发布Vista时对WIA做了一些修改,所以这可能是问题的根源。

    我将包括整个函数调用,希望为我的问题提供足够的上下文。这个函数是我编写的类模块的一部分,因此它引用了类模块中的其他函数。为了简洁起见,我把其他的函数放在外面了,但是如果需要,我会很乐意发布它们。

    'Windows Imaging Acquisition (WIA) Constants
    Private Const wiaFormatBMP As String = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
    Private Const wiaFormatGIF As String = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
    Private Const wiaFormatJPEG As String = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    Private Const wiaFormatPNG As String = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
    Private Const wiaFormatTIFF As String = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
    
    Public Function ScanPage(Optional ShowScanningWizard As Boolean = True, _
                             Optional OverWrite As Boolean = False, _
                             Optional AppendToTiff As Boolean = True, _
                             Optional DocType As scanDocType = scanAuto, _
                             Optional HRes As Integer = 150, _
                             Optional VRes As Integer = 150, _
                             Optional width As Double = 8.5, _
                             Optional height As Double = 11, _
                             Optional UseADF As Boolean = False) As Boolean
        'Windows Imaging Acquisition (WIA) Constants
    Const ScannerDeviceType = 1
    Const wiaIntentColor As Long = 1
    Const wiaIntentGray As Long = 2
    Const wiaIntentBlackWhite As Long = &H10004  '&H4 = IntentBlackWhite + &H10000 = Minimize Size   '&H20000'131072
    
    Dim cd As Object    'WIA.CommonDialog
    Dim dev As Object    'WIA.Device
    Dim ip As Object    'WIA.ImageProcess
    Dim Prop As Object    'WIA.Property
    Dim img As Object    'WIA.ImageFile
    
    Dim Intent As Long
    Dim MorePages As Boolean
    
        On Error GoTo Err_ScanPage
    
        ScanPage = False
    
        'Verify scanned page can be saved
        If Len(m_sFileName) = 0 Then
            Err.Raise 5, , "Scan Aborted - No filename provided"
        ElseIf IsTiff And AppendToTiff Then
            'we're ok
        ElseIf m_bFileExists And Not OverWrite Then
            Err.Raise 58    'File already exists
        End If
    
        Set cd = CreateObject("WIA.CommonDialog")
        Set dev = cd.ShowSelectDevice(ScannerDeviceType)
        Set ip = CreateObject("WIA.ImageProcess")
    
    
        'Set up conversion filter
        ip.Filters.Add ip.FilterInfos("Convert").FilterID
        ip.Filters(ip.Filters.Count).Properties("FormatID").Value = FileFormat
        Select Case FileFormat
        Case wiaFormatJPEG
            ip.Filters(ip.Filters.Count).Properties("Quality").Value = 85
        Case wiaFormatTIFF
            'IP.Filters(IP.Filters.Count).Properties("Compression").Value = "CCITT4"
        End Select
    
        'Set intent for current document
        If DocType <> scanAuto Then m_eScanType = DocType
        If m_eScanType = scanDocument Then
            Intent = wiaIntentBlackWhite    'wiaIntentGray
        Else
            Intent = wiaIntentColor
        End If
    
        DoEvents
        If ShowScanningWizard Then
            Set img = cd.ShowAcquireImage(ScannerDeviceType, , , FileFormat)
        Else
            With dev.items(1)
                .Properties("Current Intent").Value = Intent
                .Properties("Horizontal Resolution").Value = HRes
                .Properties("Vertical Resolution").Value = VRes
                .Properties("Horizontal Extent").Value = HRes * width
                .Properties("Vertical Extent").Value = VRes * height
                If m_eScanType = scanDocument Then
                    'Darken documents a bit so that handwriting is easier to see
                    '   * Brightness is a value between -127 and +127
                    '   * -45 was reached through trial and error and was tested on
                    '     a CanoScan LiDE 20 flatbed scanner
                    .Properties("Brightness").Value = -45
                End If
    
            End With
            On Error Resume Next
    '        For Each Prop In dev.items(1).Properties
    '            Debug.Print Prop.PropertyID, Prop.Name, Prop.Value
    '        Next Prop
            'Scan the image
            If UseADF Then
                MorePages = True
                For Each Prop In dev.Properties
                    Select Case Prop.PropertyID
                    Case 3087 'Document Handling Select (1 = ADF)
                        MorePages = MorePages And (Prop.Value = 1)
                    Case 3088 'Document Handling Status (1 = Page ready in ADF)
                        MorePages = MorePages And (Prop.Value = 1)
                    End Select
                Next Prop
                If MorePages Then Set img = cd.ShowTransfer(dev.items(1), , True) ' dev.Items(1).Transfer()
            Else
                Set img = cd.ShowTransfer(dev.items(1), , True)
            End If
            If Err.Number <> 0 Then
                'User canceled the scan (most likely cause of error)
                Err.Clear
                ScanPage = False
                GoTo Exit_ScanPage
            End If
            On Error GoTo Err_ScanPage
        End If
    
    
        If img Is Nothing Then GoTo Exit_ScanPage
        'Convert to proper format
        Set img = ip.Apply(img)
    
        If IsTiff And AppendToTiff Then
            m_iNumPages = m_iNumPages + 1
            If m_iNumPages = 1 Then
                'ReDim Preserve throws an error if the array is currently empty
                ReDim m_sFNames(1 To 1)
            Else
                ReDim Preserve m_sFNames(1 To m_iNumPages)
            End If
            m_sFNames(m_iNumPages) = TempFileName(TempFilesPath, "tif")
            img.SaveFile m_sFNames(m_iNumPages)
            SaveToMultiTiff
            m_bFileExists = True
            ExtractPages
        Else
            If m_bFileExists And OverWrite Then Kill m_sFileName
            img.SaveFile m_sFileName
            m_iNumPages = 1
            m_bFileExists = True
        End If
    
        ScanPage = True
    
    Exit_ScanPage:
        Exit Function
    Err_ScanPage:
        Select Case Err.Number
        Case Else
            LogError Err.Number, Err.Description, "ScanPage", "clsScan"
        End Select
        Resume Exit_ScanPage
    End Function
    
    1 回复  |  直到 14 年前
        1
  •  0
  •   mwolfe02    15 年前

    这在开发人员计算机(Windows7)和非生产计算机(WindowsXP)中工作的原因与操作系统无关。不同之处实际上在于驱动程序版本。当我在dev机器上测试扫描仪时,它连接到Windows Update并下载了该扫描仪可用的最新驱动程序。WinXP机器使用的是同一个扫描仪的旧驱动程序。通过将WinXP机器上的扫描仪驱动程序更新到最新版本,它解决了我的问题。