使用 VBA 使用 ADF 扫描仪扫描多页
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17008480/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Scan multiple pages with ADF scanner using VBA
提问by Yotam
I am writing a Microsoft Access application and I want to enable the user to scan multiple pages to a single PDF format. The conversion to PDF works fine once I have all the pages scanned. Here's my code:
我正在编写一个 Microsoft Access 应用程序，我希望用户能够将多个页面扫描为单个 PDF 格式。一旦我扫描了所有页面，转换为 PDF 就可以正常工作。这是我的代码：
Option Compare Database
Option Explicit
Const WIA_FORMAT_JPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Public Function MyScan()
Dim ComDialog As WIA.CommonDialog
Dim DevMgr As WIA.DeviceManager
Dim DevInfo As WIA.DeviceInfo
Dim dev As WIA.Device
Dim img As WIA.ImageFile
Dim i As Integer
Dim wiaScanner As WIA.Device
Set ComDialog = New WIA.CommonDialog
Set wiaScanner = ComDialog.ShowSelectDevice(WiaDeviceType.UnspecifiedDeviceType, False, True)
Set DevMgr = New WIA.DeviceManager
For i = 1 To DevMgr.DeviceInfos().Count
If DevMgr.DeviceInfos(i).DeviceID = wiaScanner.DeviceID Then
Set DevInfo = DevMgr.DeviceInfos(i)
End If
Next i
Set dev = DevInfo.Connect
Set img = dev.Items(1).Transfer(WIA_FORMAT_JPEG)
img.SaveFile "C:\img.jpg"
Set img = Nothing
Set dev = Nothing
Set DevInfo = Nothing
Set DevMgr = Nothing
Set ComDialog = Nothing
End Function
Of course it is important to say that my scanner is Avision AV121with an automatic document feeder.
当然，重要的是要说我的扫描仪是带有自动文档进纸器的Avision AV121。
My problem is that Set img = dev.Items(1).Transfer(WIA_FORMAT_JPEG)scans ALL the pages at once (and not just a single page) but I only see the first one in the image file. Because all the pages are scanned at once, I can't do it in a loop - an error will be raised in the second iteration (saying that the feeder is empty as it really is) and I still only have the first page scanned.
我的问题是Set img = dev.Items(1).Transfer(WIA_FORMAT_JPEG)一次扫描所有页面（而不仅仅是单个页面），但我只看到图像文件中的第一个。因为一次扫描所有页面，所以我不能循环扫描 - 第二次迭代时会出现错误（说进纸器实际上是空的），我仍然只扫描了第一页。
I would like to state that this seems to be a common problem. I've read a lot of threads regarding this problem, but didn't find anything that answered my question.
我想说明这似乎是一个普遍的问题。我已经阅读了很多关于这个问题的线程，但没有找到任何可以回答我的问题的内容。
I hope to find help here, I am really frustrated.
我希望能在这里找到帮助，我真的很沮丧。
Many thanks
非常感谢
采纳答案by E Mett
I had this problem myself.
我自己也有这个问题。
I cannot remember where I found that this is probably a limitation of WIA, a bug I think. Maybe only in some circumstances.
我不记得我在哪里发现这可能是 WIA 的限制，我认为是一个错误。也许只是在某些情况下。
My solution was to use a 3rd party scanning control.
我的解决方案是使用第 3 方扫描控件。
回答by chalermpon
For anyone still working on the problem, I modified this code from JIM's code to work with a scanner with a ADF. It scans the documents continuously unlimit pages and stores them as a jpeg file temporarily. It then outputs a report to a pdf. This is the only way I can figure out scanning multiple documents using an ADF scanner.
对于仍在解决这个问题的任何人，我从 JIM 的代码中修改了这段代码，以便与带有 ADF 的扫描仪一起使用。它连续扫描文档，无限制页面并将它们临时存储为 jpeg 文件。然后将报告输出为 pdf。这是我使用 ADF 扫描仪扫描多个文档的唯一方法。
'Requirements:
'Must include reference to Microsoft Windows Image Acquisition 2.0 dll
'Create a table named scantemp. Create ID column as Autonumber. Create 2nd column named Picture with Text as datatype.
'Create a continuous report named rptscan. Set scantemp table as recordsource. Add image control to report and set Picture
'as the control source. Make the image control the size of an 8.5 x 11 sheet so that the whole document appears normally when the
'create textbox set name txt_id for enter PDF files name
'report is exported to pdf.
'For use with a scanner that continually scans documents until the ADF tray is empty unlimit pages.
option Compare Database
Option Explicit
Const WIA_FORMAT_JPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Public Sub ScanDocs()
Dim intPages As Integer 'number of pages
Dim img As WIA.ImageFile
Dim strPath As String
Dim strFileJPG As String
strPath = CurrentProject.Path 'set path to save files
intPages = 1
On Error GoTo ErrorHandler
'scan
ScanStrat:
Dim DialogScan As New WIA.CommonDialog, dpi As Integer, pp As Integer, l As Integer
dpi = 250
Dim Scanner As WIA.Device
Set Scanner = DialogScan.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False)
'set properties device
Scanner.Properties("3088").Value = 1 'Automatic Document Feeder
Scanner.Items(1).Properties("6146").Value = 4 'Colour intent
Scanner.Items(1).Properties("6147").Value = dpi 'DPI horizontal
Scanner.Items(1).Properties("6148").Value = dpi 'DPI vertical
Scanner.Items(1).Properties("6149").Value = 0 'x point to start scan
Scanner.Items(1).Properties("6150").Value = 0 'y point to start scan
Scanner.Items(1).Properties("6151").Value = 8.27 * dpi 'Horizontal extent
Scanner.Items(1).Properties("6152").Value = 11.7 * dpi 'Vertical extent for A4
Scanner.Items(1).Properties("6154").Value = 80 'brightness
' Scanner.Items(1).Properties("6155").Value = 30 'contrast
'Start Scan if err number -2145320957 Scan document finish
Do While Err.Number <> -2145320957 'error number is ADF status don't feed document
Set img = Scanner.Items(1).Transfer(WIA_FORMAT_JPEG)
strFileJPG = strPath & "\FileScan\temp\" & CStr(intPages) & ".jpg"
img.SaveFile (strFileJPG) 'save files .jpg in temp folder
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')" 'insert picture temp to table scan temp
intPages = intPages + 1 'add number pages
Loop
'after finish scan start convert to pdf
StartPDFConversion:
Dim strFilePDF As String '
Dim RptName As String
strFilePDF = CurrentProject.Path & "\FileScan\" & txt_id.Value & ".pdf" 'pdf file name by textbox
RptName = "rptScan" 'report picture file for export to PDF
DoCmd.OpenReport RptName, acViewDesign, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
DoCmd.RunSQL "delete from scantemp" 'delete all data from table scantemp
DeleteTemp:
'delete files temp (JPG)
Dim i As Integer
Dim filesname As String
i = 1
'loop pages number (intpages)
Do While i < intPages
filesname = CurrentProject.Path & "\FileScan\temp\" & i & ".jpg"
If Dir(filesname) <> "" Then
'SetAttr filesname, vbNormal
Kill filesname
Else
Exit Do
End If
i = i + 1
Loop
MsgBox ("done")
Exit Sub
ErrorHandler:
Select Case Err.Number
Case -2145320957
If intPages = 1 Then
MsgBox ("not found document to scan")
Exit Sub
Else
GoTo StartPDFConversion
End If
End Select
MsgBox "Error" & ": " & Err.Number & vbCrLf & "Description: " _
& Err.Description, vbExclamation, Me.Name & ".ScanDocs"
End Sub
回答by user2813440
It's a not supported drive. I solve this installing original Twain Drive for Brother DCP-8157
这是一个不受支持的驱动器。我解决了为 Brother DCP-8157 安装原始 Twain Drive 的问题
回答by Jim
I modified this code to work with a scanner with a ADF. It scans the documents continuously up to 10 pages and stores them as a jpeg file temporarily. It then outputs a report to a pdf. This is the only way I can figure out scanning multiple documents using an ADF scanner using WIA without using a 3rd party app.
我修改了此代码以使用带有 ADF 的扫描仪。它可以连续扫描多达 10 页的文档，并将它们临时存储为 jpeg 文件。然后将报告输出为 pdf。这是我在不使用第三方应用程序的情况下使用 WIA 使用 ADF 扫描仪扫描多个文档的唯一方法。
'This code was originally designed by http://kbase.icbconsulting.com/vba/scan-documents-into-an-access-database
'Details: This code will continually scan up to 10 documents using a scanner with an Automatic Document Feeder(ADF) and then export the jpeg
'images to (1) pdf file.
'Code tested using an HP OfficeJet 6600 Wireless All-in-one Printer.
'Requirements:
'Must include reference to Microsoft Windows Image Acquisition 2.0 dll
'Create a table named scantemp. Create ID column as Autonumber. Create 2nd column named Picture with Text as datatype.
'Create a continuous report named rptscan. Set scantemp table as recordsource. Add image control to report and set Picture
'as the control source. Make the image control the size of an 8.5 x 11 sheet so that the whole document appears normally when the
'report is exported to pdf.
'For use with a scanner that continually scans documents until the ADF tray is empty.
'NOTE: I previosuly coded this to scan up to 20 documents at once. It would always get to the 11th or 12th page and then Access 2010
'would crash (Not Responding). It would be interesting to see if someone can come up with a way to scan more that 10 documents
'with this code.
Public Sub ScanDocs()
'ErrorHandler traps feeder empty error after all documents are scanned, then begins jpeg-to-pdf file conversion
On Error GoTo ErrorHandler
'Initial Document Load into scanner
If MsgBox("Set documents (Max. 10) in the Automatic Document Feeder and then click OK.", vbOKCancel, "Scan Start") = vbCancel Then
MsgBox ("Scan Canceled")
GoTo ProcedureExit
Else
GoTo ScanStart
End If
ScanStart:
'Setup WIA imaging device for scanning
Dim Dialog1 As New WIA.CommonDialog, dpi As Integer, PP As Integer, l As Integer
dpi = 300
Dim Scanner As WIA.Device
Set Scanner = Dialog1.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False)
'Set Document Properties and Feeder Setup
Scanner.Properties("3088").Value = 1 'Automatic Document Feeder
Scanner.Items(1).Properties("6146").Value = 4 'Colour intent
Scanner.Items(1).Properties("6147").Value = dpi 'DPI horizontal
Scanner.Items(1).Properties("6148").Value = dpi 'DPI vertical
Scanner.Items(1).Properties("6149").Value = 0 'x point to start scan
Scanner.Items(1).Properties("6150").Value = 0 'y point to start scan
Scanner.Items(1).Properties("6151").Value = 8.5 * dpi 'Horizontal extent
Scanner.Items(1).Properties("6152").Value = 11# * dpi 'Vertical extent for letter
'Scanner.Items(1).Properties("6154").Value = -30 'brightness
'Scanner.Items(1).Properties("6155").Value = 30 'contrast
'Start first page scan
Dim intPages As Integer
Dim img As WIA.ImageFile
Set img = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG As String
strFileJPG = "c:.jpg"
img.SaveFile (strFileJPG)
intPages = 1
'Then every subsequent scan thereafter
Dim img2 As WIA.ImageFile
Set img2 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG2 As String
strFileJPG2 = "c:.jpg"
img2.SaveFile (strFileJPG2)
intPages = intPages + 1
Dim img3 As WIA.ImageFile
Set img3 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG3 As String
strFileJPG3 = "c:.jpg"
img3.SaveFile (strFileJPG3)
intPages = intPages + 1
Dim img4 As WIA.ImageFile
Set img4 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG4 As String
strFileJPG4 = "c:.jpg"
img4.SaveFile (strFileJPG4)
intPages = intPages + 1
Dim img5 As WIA.ImageFile
Set img5 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG5 As String
strFileJPG5 = "c:.jpg"
img5.SaveFile (strFileJPG5)
intPages = intPages + 1
Dim img6 As WIA.ImageFile
Set img6 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG6 As String
strFileJPG6 = "c:.jpg"
img6.SaveFile (strFileJPG6)
intPages = intPages + 1
Dim img7 As WIA.ImageFile
Set img7 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG7 As String
strFileJPG7 = "c:.jpg"
img7.SaveFile (strFileJPG7)
intPages = intPages + 1
Dim img8 As WIA.ImageFile
Set img8 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG8 As String
strFileJPG8 = "c:.jpg"
img8.SaveFile (strFileJPG8)
intPages = intPages + 1
Dim img9 As WIA.ImageFile
Set img9 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG9 As String
strFileJPG9 = "c:.jpg"
img9.SaveFile (strFileJPG9)
intPages = intPages + 1
Dim img10 As WIA.ImageFile
Set img10 = Scanner.Items(1).Transfer("{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}")
Dim strFileJPG10 As String
strFileJPG10 = "c:.jpg"
img10.SaveFile (strFileJPG10)
intPages = intPages + 1
'Starts the jpeg-to-pdf conversion
StartPDFConversion:
Dim strFilePDF As String
'set pdf output path
strFilePDF = "c:\pdf.pdf"
DoCmd.SetWarnings False
'delete previously processed images from scantemp table
DoCmd.RunSQL "delete from scantemp"
'insert all newly scanned images into scantemp table
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')"
If intPages >= 2 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG2 & "')"
End If
If intPages >= 3 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG3 & "')"
End If
If intPages >= 4 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG4 & "')"
End If
If intPages >= 5 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG5 & "')"
End If
If intPages >= 6 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG6 & "')"
End If
If intPages >= 7 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG7 & "')"
End If
If intPages >= 8 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG8 & "')"
End If
If intPages >= 9 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG9 & "')"
End If
If intPages >= 10 Then
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG10 & "')"
End If
'output rptscan to predefined file path
Dim RptName As String
RptName = "rptScan"
DoCmd.OpenReport RptName, acViewDesign, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
'delete all jpeg files after report output
Dim fso46 As New FileSystemObject
fso46.DeleteFile strFileJPG
If intPages = 2 Then
fso46.DeleteFile strFileJPG2
ElseIf intPages = 3 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
ElseIf intPages = 4 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
ElseIf intPages = 5 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
ElseIf intPages = 6 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
ElseIf intPages = 7 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
ElseIf intPages = 8 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
ElseIf intPages = 9 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
fso46.DeleteFile strFileJPG9
ElseIf intPages = 10 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
fso46.DeleteFile strFileJPG9
fso46.DeleteFile strFileJPG10
End If
Set fso46 = Nothing
DoCmd.SetWarnings True
MsgBox ("Done!")
ProcedureExit:
Exit Sub
ErrorHandler:
'Traps 'out of paper error.' Asks user if all documents were scanned properly, if yes is chosen, start PDF conversion, if no, restarts
'scan subroutine.
Select Case Err.Number
Case -2145320957
If MsgBox("Were all documents successfully scanned?", vbYesNo, "Confirm Scan") = vbYes Then
GoTo StartPDFConversion
Else
Call scan
End If
End Select
'Handles any other errors in subroutine
MsgBox "Error" & ": " & Err.Number & vbCrLf & "Description: " _
& Err.Description, vbExclamation, Me.Name & ".ScanDocs"
Resume ProcedureExit
End Sub
回答by Russian Ivan
I have a similar problem. Writing in MS Access. To scan from the scanner Broter 7065, with ADF, in a single PDF file. And no time to write your own code. A lot searched, but found not what I needed. The problem was solved with the help of the program "quick scan Command line TWAIN scanning"http://www.burrotech.com/quickscan/
我有一个类似的问题。用 MS Access 编写。使用 ADF 从扫描仪 Broter 7065 扫描单个 PDF 文件。没有时间编写自己的代码。搜索了很多，但没有找到我需要的。问题在程序“快速扫描命令行TWAIN扫描”的帮助下解决了http://www.burrotech.com/quickscan/
Private Sub Button27_Click()
Dim Nomer As Integer
Nomer = Forms!Nakladnaya!NomerLink ' invoice number from form
Shell CurrentProject.Path & "\quickscan.exe resolution 100 pdf showprogress filename " & CurrentProject.Path & "\scan\ScanN1" & Nomer & "23.pdf "
End Sub
回答by Russian Ivan
For anyone still working on the problem, I found the following solutions:
对于仍在解决该问题的任何人，我找到了以下解决方案：
Depending on which formatID one uses for the Scanner.Items(1).Transfer("formatID"), my scanner either stopped after scanning 1 paper or continued scanning (it only worked with BMP for me, and I am using an HP Officejet J4680).
根据 Scanner.Items(1).Transfer("formatID") 使用的 formatID，我的扫描仪要么在扫描 1 张纸后停止，要么继续扫描（它只对我使用 BMP，我使用的是 HP Officejet J4680 ）。
I then used as variable say ADFstatus that reads whether there is still a paper in the feeder and used this to create a while loop.(wiaScanner.Properties.Item("3087")). I then saved each scanned image separately, and it causes the ADF scanner to stop after each scan instead of scanning all papers at once.
然后我使用变量说 ADFstatus 读取进纸器中是否还有纸，并用它来创建一个 while 循环。(wiaScanner.Properties.Item("3087"))。然后我分别保存每个扫描的图像，它会导致 ADF 扫描仪在每次扫描后停止，而不是一次扫描所有纸张。
for example:
例如：
Dim wiaImg As WIA.ImageFile
ADFStatus = wiaScanner.Properties.Item("3087").Value
counter = 0
While ADFStatus
counter = counter + 1
Set wiaImg = wiaScanner.Items(1).Transfer(WIA.FormatID.wiaFormatBMP)
wiaImg.SaveFile ("C:\Test\" & counter & ".bmp")
Set wiaImg = Nothing
ADFStatus = wiaScanner.Properties.Item("3087").Value
Wend
Hope this helps
希望这可以帮助
回答by Ian Moore
Another alternative is to acquire the images as wiaFormatTIFF which will result in a multi-page tiff. You can then loop through each page in the tiff and save each if you require separate images.
另一种选择是将图像作为 wiaFormatTIFF 获取，这将导致多页 tiff。然后，您可以遍历 tiff 中的每个页面，并在需要单独的图像时保存每个页面。
