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

Vba WIA文档处理状态返回0,即使ADF已加载页面,vba,wia,image-scanner,Vba,Wia,Image Scanner,我正在尝试使用VBA和Windows图像采集库WIA从ADF进行扫描。我正在尝试检查ADF中是否加载了页面,以便知道是否要扫描其他页面。此功能似乎在Windows 7 my dev机器上运行良好,但在Windows XP生产机器上运行不正常。我知道微软在发布Vista时对WIA做了一些修改,所以这可能是问题的根源 我将包括整个函数调用,希望为我的问题提供足够的上下文。此函数是我编写的类模块的一部分,因此它引用类模块中的其他函数。为了简洁起见,我省略了其他函数,但如果有人要求,我会很乐意发布它们

我正在尝试使用VBA和Windows图像采集库WIA从ADF进行扫描。我正在尝试检查ADF中是否加载了页面,以便知道是否要扫描其他页面。此功能似乎在Windows 7 my dev机器上运行良好,但在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

这在开发机器Windows 7而不是生产机器Windows XP中起作用的原因与操作系统无关。区别实际上在于驱动程序版本。当我在开发机器上测试扫描仪时,它连接到Windows update并下载了该扫描仪可用的最新驱动程序。WinXP机器对同一扫描仪使用了较旧的驱动程序。通过将WinXP机器上的扫描仪驱动程序更新到最新版本,它解决了我的问题。

这在开发机器Windows 7而不是生产机器Windows XP中起作用的原因与操作系统无关。区别实际上在于驱动程序版本。当我在开发机器上测试扫描仪时,它连接到Windows update并下载了该扫描仪可用的最新驱动程序。WinXP机器对同一扫描仪使用了较旧的驱动程序。通过将WinXP机器上的扫描仪驱动程序更新为最新版本,它解决了我的问题。

您好,对于您回答的关于类中其他相关函数的问题,如果可能的话,我想看一份副本。谢谢Jeroen@mrdevis:最终会有很多其他依赖项。我最初提出展示这些其他部件的原因是为了帮助潜在的故障排除者。我已经解决了我自己的问题,所以我不太愿意麻烦地发布所有其他函数和依赖项。如果您有关于从vba扫描或使用wia的特定问题,最好发布您自己的问题。您好,关于您的问题,请使用您的类的其他相关函数进行回答,如果可能的话,我希望看到该问题的副本。谢谢Jeroen@mrdevis:最终会有很多其他依赖项。我最初提出展示这些其他部件的原因是为了帮助潜在的故障排除者。我已经解决了我自己的问题,所以我不太愿意麻烦地发布所有其他函数和依赖项。如果您有关于从vba扫描或使用wia的特定问题,最好发布您自己的问题。