Fatal编程技术网
  • vba/
  • 使用VBA使用ADF扫描仪扫描多个页面

使用VBA使用ADF扫描仪扫描多个页面

vba ms-access

使用VBA使用ADF扫描仪扫描多个页面,vba,ms-access,wia,scanning,Vba,Ms Access,Wia,Scanning,我正在编写一个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

我正在编写一个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
当然，重要的是，我的扫描仪带有自动文档进纸器

我的问题是
Set img=dev.Items（1）.Transfer（WIA_FORMAT_JPEG）
一次扫描所有页面（而不仅仅是单个页面），但我只看到图像文件中的第一个页面。因为所有的页面都是一次扫描的，所以我不能在一个循环中完成——在第二次迭代中会出现一个错误（说进纸器实际上是空的），我仍然只扫描了第一页

我想指出，这似乎是一个普遍的问题。我已经阅读了很多关于这个问题的帖子，但是没有找到任何可以回答我问题的东西

我希望能在这里找到帮助，我真的很沮丧

非常感谢

我自己也有这个问题

我不记得我在哪里发现这可能是WIA的一个缺陷，我想这是一个缺陷。也许只是在某些情况下

我的解决方案是使用第三方扫描控件。

我修改了此代码，使其与带有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:\1.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:\2.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:\3.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:\4.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:\5.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:\6.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:\7.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:\8.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:\9.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:\10.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
我也有类似的问题。在MS Access中写入。使用ADF从扫描仪Broter 7065扫描单个PDF文件。没有时间编写自己的代码。找了很多，但没有找到我需要的。 借助“快速扫描命令行TWAIN扫描”程序解决了该问题

对于仍在解决此问题的任何人，我找到了以下解决方案：

根据扫描仪.Items（1）.Transfer（“formatID”）使用的formatID，我的扫描仪在扫描1张纸后停止扫描或继续扫描（它只对我使用BMP，我使用的是HP Officejet J4680）

然后我使用变量say ADFstatus读取进纸器中是否还有纸张，并使用它创建while循环（wiaScanner.Properties.Item（“3087”））。然后，我分别保存了每个扫描的图像，这会导致ADF扫描仪在每次扫描后停止，而不是一次扫描所有纸张

例如：

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
希望这有帮助

另一种选择是以wiaFormatTIFF格式获取图像，这将导致多页tiff。然后，如果需要单独的图像，您可以循环浏览tiff中的每个页面并保存每个页面。

对于仍在处理此问题的任何人，我将JIM代码中的此代码修改为使用带有ADF的扫描仪。它连续扫描文档，取消页面限制，并将其临时存储为jpeg文件。然后将报告输出为pdf格式。这是唯一一种使用ADF扫描仪扫描多个文档的方法

”要求：
'必须包含对Microsoft Windows Image Acquisition 2.0 dll的引用
'创建一个名为scantemp的表。将ID列创建为自动编号。创建名为Picture的第二列，文本为数据类型。
'创建名为rptscan的连续报告。将scantemp表设置为recordsource。将图像控件添加到报告并设置图片
'作为控制源。使图像控制为8.5 x 11页的大小，以便在打印时整个文档正常显示
'为输入PDF文件名创建文本框设置名称txt\U id
'报告将导出为pdf格式。
'与扫描仪配合使用，该扫描仪可连续扫描文档，直到ADF托盘清空未提交的页面。
选项比较数据库
选项显式
Const WIA_FORMAT_JPEG=“{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}”
斯堪的纳维亚公共分公司（）
Dim intPages作为整数的页数
将img设置为WIA.ImageFile
将strPath设置为字符串
作为字符串的Dim strFileJPG
strPath=CurrentProject.Path'设置保存文件的路径
intPages=1
关于错误转到错误处理程序
“扫描
Scanstart：
Dim对话框扫描为新WIA.CommonDialog，dpi为整数，pp为整数，l为整数
dpi=250
作为WIA.设备的Dim扫描仪
设置扫描仪=DialogScan.ShowSelectDevice（WIA.WiaDeviceType.ScannerDeviceType，False，False）
'设置设备的属性
扫描仪。属性（“3088”）。值=1'自动文档进纸器
扫描仪.项目（1）.属性（“6146”）.值=4'颜色
扫描仪。项目（1）。属性（“6147”）。值=dpi’dpi水平
扫描仪。项目（1）。属性（“6148”）。值=dpi’dpi垂直
扫描仪。项目（1）。属性（“6149”）。值=0'x开始扫描的点
扫描仪。项目（1）。属性（“6150”）。值=0'y点开始扫描
扫描仪.项目（1）.属性（“6151”）.值=8.27*dpi'水平范围
扫描仪.项目（1）.属性（“6152”）.A4的值=11.7*dpi'垂直范围
扫描仪.项目（1）.属性（“6154”）.值=80'亮度
'Scanner.Items（1）.属性（“6155”）。值=30'对比度
'如果错误编号为2145320957，则开始扫描文档完成
Do While Err.Number-2145320957'错误号为ADF状态不馈送文档
设置img=Scanner.Items（1）.传输（WIA\u格式\u JPEG）
strFileJPG=strPath&“\FileScan\temp\”&CStr（intPages）和“.jpg”
img.SaveFile（strFileJPG）'将files.jpg保存在临时文件夹中
DoCmd.SetWarnings错误
DoCmd.RunSQL“插入扫描温度（图片）值（''”&strFileJPG&“）””将图片温度插入表扫描温度
intPages=intPages+1'添加页数
环
'完成扫描后开始转换为pdf
StartPDF转换：
Dim strFilePDF作为字符串'
将名称设置为字符串
strFilePDF=CurrentProject.Path&“\FileScan\”&txt\u id.Value&“.pdf”'pdf文件名按文本框
RptName=“rptScan”报告图片文件以导出为PDF
DoCmd.OpenReport RptName，acViewDesign，acHidden

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



'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