D
deko
I've automated my scanner, but for some reason I can't set the all
properties I need. Specifically, everything is scanned with color settings,
so I get huge scans when I only need black and white.
But Windows Fax and Scan--which also uses WIA--seems to work fine (Note: I
have NOT loaded any drivers from the scanner vendor).
Am I coding something wrong? Here's my code, with comments where broken:
Public Function GetScan(strFileName As String) As Boolean
On Error GoTo HandleErr
Dim intRes As Integer
Dim strFormat As String
Dim strFullPath As String
Dim dlg As WIA.CommonDialog
Dim mgr As WIA.DeviceManager
Dim prc As WIA.ImageProcess
Dim dev As WIA.Device
Dim img As WIA.ImageFile
Dim imgFmt As WIA.ImageFile
Dim itm As WIA.Item
Dim prp As WIA.Property
Dim flis As WIA.FilterInfos
Set dlg = New WIA.CommonDialog
Set mgr = New WIA.DeviceManager
Set dev = dlg.ShowSelectDevice
'dev.Properties("Document Handling Status") = 1 'can't set this...
'have not been able to set dev props
'Debug.Print "##### device properties #####"
'For Each prp In dev.Properties
' Debug.Print prp.Name & " = " & prp.Value
'Next
Set itm = dev.Items(1)
'can only set resolutioin, brightness, and contrast for item properties
intRes = Nz(DLookup("Resolution", "tblPreferences"), 300)
'itm.Properties("Current Intent") = 4 'why won't TextIntenet (constant
= 4) work here?
itm.Properties("Horizontal Resolution") = intRes
itm.Properties("Vertical Resolution") = intRes
itm.Properties("Brightness") = Nz(DLookup("Brightness",
"tblPreferences"), 0)
itm.Properties("Contrast") = Nz(DLookup("Contrast", "tblPreferences"),
0)
'itm.Properties("Media Type") = 2 'can't set this...
'itm.Properties("Color Profile Name") = "sRGB Color Space Profile.icm" -
do I need to set this
'Debug.Print "##### item props #####"
'For Each prp In itm.Properties
' Debug.Print prp.Name & " = " & prp.Value
'Next
'GoTo Exit_Here
Set img = dlg.ShowTransfer(itm)
'the ShowTransfer method returns an ImageFile object in the format
'specified in FormatID if the device supports that format, otherwise
'the method uses the preferred format for the imaging device.
'Apparently, the preferred format of the current scanner is BMP, and
'FormatID parameter is ignored if we change it, so it is omitted.
'I'm wondering if this is the problem - since I'm scanning a BMP, it's
color.
'How do I set the format to something different?
Set prc = New WIA.ImageProcess
Set flis = prc.FilterInfos
prc.Filters.Add flis("Convert").FilterID
strFormat = Nz(DLookup("FileFormat", "tblPreferences"), "TIFF")
Select Case strFormat
Case "TIFF"
prc.Filters(1).Properties("FormatID").Value = wiaFormatTIFF
Case "BMP"
prc.Filters(1).Properties("FormatID").Value = wiaFormatBMP
Case "PNG"
prc.Filters(1).Properties("FormatID").Value = wiaFormatPNG
Case "GIF"
prc.Filters(1).Properties("FormatID").Value = wiaFormatGIF
Case "JPEG"
prc.Filters(1).Properties("FormatID").Value = wiaFormatJPEG
End Select
Set imgFmt = prc.Apply(img)
strFullPath = DLookup("DocDir", "tblPreferences") & "\" & _
strFileName & "." & imgFmt.FileExtension
imgFmt.SaveFile strFullPath
GetScan = True
Exit_Here:
[error handling code omitted]
properties I need. Specifically, everything is scanned with color settings,
so I get huge scans when I only need black and white.
But Windows Fax and Scan--which also uses WIA--seems to work fine (Note: I
have NOT loaded any drivers from the scanner vendor).
Am I coding something wrong? Here's my code, with comments where broken:
Public Function GetScan(strFileName As String) As Boolean
On Error GoTo HandleErr
Dim intRes As Integer
Dim strFormat As String
Dim strFullPath As String
Dim dlg As WIA.CommonDialog
Dim mgr As WIA.DeviceManager
Dim prc As WIA.ImageProcess
Dim dev As WIA.Device
Dim img As WIA.ImageFile
Dim imgFmt As WIA.ImageFile
Dim itm As WIA.Item
Dim prp As WIA.Property
Dim flis As WIA.FilterInfos
Set dlg = New WIA.CommonDialog
Set mgr = New WIA.DeviceManager
Set dev = dlg.ShowSelectDevice
'dev.Properties("Document Handling Status") = 1 'can't set this...
'have not been able to set dev props
'Debug.Print "##### device properties #####"
'For Each prp In dev.Properties
' Debug.Print prp.Name & " = " & prp.Value
'Next
Set itm = dev.Items(1)
'can only set resolutioin, brightness, and contrast for item properties
intRes = Nz(DLookup("Resolution", "tblPreferences"), 300)
'itm.Properties("Current Intent") = 4 'why won't TextIntenet (constant
= 4) work here?
itm.Properties("Horizontal Resolution") = intRes
itm.Properties("Vertical Resolution") = intRes
itm.Properties("Brightness") = Nz(DLookup("Brightness",
"tblPreferences"), 0)
itm.Properties("Contrast") = Nz(DLookup("Contrast", "tblPreferences"),
0)
'itm.Properties("Media Type") = 2 'can't set this...
'itm.Properties("Color Profile Name") = "sRGB Color Space Profile.icm" -
do I need to set this
'Debug.Print "##### item props #####"
'For Each prp In itm.Properties
' Debug.Print prp.Name & " = " & prp.Value
'Next
'GoTo Exit_Here
Set img = dlg.ShowTransfer(itm)
'the ShowTransfer method returns an ImageFile object in the format
'specified in FormatID if the device supports that format, otherwise
'the method uses the preferred format for the imaging device.
'Apparently, the preferred format of the current scanner is BMP, and
'FormatID parameter is ignored if we change it, so it is omitted.
'I'm wondering if this is the problem - since I'm scanning a BMP, it's
color.
'How do I set the format to something different?
Set prc = New WIA.ImageProcess
Set flis = prc.FilterInfos
prc.Filters.Add flis("Convert").FilterID
strFormat = Nz(DLookup("FileFormat", "tblPreferences"), "TIFF")
Select Case strFormat
Case "TIFF"
prc.Filters(1).Properties("FormatID").Value = wiaFormatTIFF
Case "BMP"
prc.Filters(1).Properties("FormatID").Value = wiaFormatBMP
Case "PNG"
prc.Filters(1).Properties("FormatID").Value = wiaFormatPNG
Case "GIF"
prc.Filters(1).Properties("FormatID").Value = wiaFormatGIF
Case "JPEG"
prc.Filters(1).Properties("FormatID").Value = wiaFormatJPEG
End Select
Set imgFmt = prc.Apply(img)
strFullPath = DLookup("DocDir", "tblPreferences") & "\" & _
strFileName & "." & imgFmt.FileExtension
imgFmt.SaveFile strFullPath
GetScan = True
Exit_Here:
[error handling code omitted]