即使 ADF 已加载页面,WIA 文档处理状态也会返回 0
我正在尝试使用 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
I'm trying to scan from an ADF using VBA and the Windows Image Acquisition library (WIA). I am trying to check to see if there are pages loaded in the ADF so I know whether to scan another page. This function seems to work well in Windows 7 (my dev machine) but not in Windows XP (the production machines). I know MS made some changes to WIA when it released Vista, so this may be the root of the issue.
I'll include the entire function call to hopefully provide enough context to my question. This function is part of a class module I've written, so it references other functions within the class module. In the interest of brevity, I've left those other functions out, but will gladly post them if requested.
'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
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
这在开发机器(Windows 7)而不是生产机器(Windows XP)中起作用的原因与操作系统没有任何关系。差异实际上在于驱动程序版本。当我在开发计算机上测试扫描仪时,它连接到 Windows 更新并下载了适用于该扫描仪的最新驱动程序。 WinXP 机器使用同一扫描仪的旧驱动程序。通过将 WinXP 机器上的扫描仪驱动程序更新到最新版本,它解决了我的问题。
The reason this worked in the dev machine (Windows 7) and not production machines (Windows XP) did not have anything to do with the operating system. The difference was actually in the driver version. When I tested the scanner on the dev machine, it connected to Windows update and downloaded the most recent driver available for that scanner. The WinXP machines were using older drivers for the same scanner. By updating the scanner drivers on the WinXP machines to the latest version, it fixed my problem.