使用大炮扫描仪在vba中扫描图像不起作用

时间:2016-11-17 17:26:48

标签: vba

我有一个vba代码,扫描扫描图像,代码工作,并没有任何问题类型HP兄弟扫描仪,但当我用它与佳能无法找到扫描仪和发送消息没有wia设备。如何解决这个问题

  Private Sub Command10_Click()
    Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    On Error GoTo Handle_Err
    Dim Dialog1 As New WIA.CommonDialog, DPI As Integer, PP As Integer, l As Integer
    Dim Scanner As WIA.Device
    Dim img As WIA.ImageFile
    Dim intPages As Integer
    Dim strFileJPG As String
    Dim blnContScan As Boolean ' to activate the scanner to start scan
    Dim ContScan As String    'msgbox to chk if more pages are to be scanned
    Dim strFilePDF As String
    Dim RptName As String
    Dim strProcName As String

    strProcName = "ScanDocs"
    DoCmd.SetWarnings False
    DoCmd.RunSQL "delete from scantemp"
    DoCmd.SetWarnings False


    blnContScan = True


    intPages = 0

    Do While blnContScan = True
        DPI = 200
        PP = 1 'No of pages
        Set Scanner = Dialog1.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, True, False)
       Set img = Dialog1.ShowTransfer(Scanner.Items(1), wiaFormatJPEG, True)
       strFileJPG = ""

        intPages = intPages + 1

    strFileJPG = "\\User-pc\saveimage\" & num & Trim(str(intPages)) & ".jpg"

       img.SaveFile (strFileJPG)

        DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')"

        DoCmd.SetWarnings False
        Set Scanner = Nothing
        Set img = Nothing
       ' strFileJPG = ""

         'Prompt user if there are additional pages to scan

        ContScan = MsgBox("?save another page ", vbQuestion + vbYesNoCancel)
              If ContScan = vbNo Then
            blnContScan = False

            ElseIf ContScan = vbCancel Then

            DoCmd.RunSQL "delete from scantemp where picture = '" & strFileJPG & "'"


        End If


            '''''''''''''''
    Loop


       Dim Image_Path As String
        GoTo StartPDFConversion
    StartPDFConversion:
     Dim s As String
    strFilePDF = "\\User-pc\saveimage\" & (num) & ".pdf"
    RptName = "rptScan"
    DoCmd.OpenReport RptName, acViewReport, , , acHidden
    DoCmd.Close acReport, RptName, acSaveYes
    DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
     Me.imgp = strFilePDF
    DoCmd.RunSQL "delete from scantemp" 'delete all data from table scantemp after converted it to pdf

    '/*******************************\


    '/********************************************\



    Handle_Exit:

        Exit Sub

    Handle_Err:
        Select Case Err.Number
            Case 2501
                Resume Handle_Exit

            Case Else

                MsgBox "the." & vbCrLf & vbCrLf & _
                "In Function:" & vbTab & strProcName & vbCrLf & _
                "Err Number: " & vbTab & Err.Number & vbCrLf & _
                "Description: " & vbTab & Err.Description, 0, _
                "Error in " & Chr$(34) & strProcName & Chr$(34)
                Resume Handle_Exit
        End Select

        Exit Sub
    End Sub

1 个答案:

答案 0 :(得分:0)

    Option Compare Database

Private Declare Function TWAIN_AcquireToFilename Lib "TWAIN32d.DLL" (ByVal hwndApp As Long, ByVal bmpFileName As String) As Integer
Private Declare Function TWAIN_IsAvailable Lib "TWAIN32d.DLL" () As Long
Private Declare Function TWAIN_SelectImageSource Lib "TWAIN32d.DLL" (ByVal hwndApp As Long) As Long

Private Sub cmdScan_Click()
Dim Ret As Long, PictureFile As String
Dim intPages As Integer
Dim blnContScan As Boolean
Dim ContScan As String    'msgbox to chk if more pages are to be scanned

blnContScan = True

intPages = 0
Do While blnContScan = True
    DPI = 200
    PP = 1 'No of pages
     intPages = intPages + 1
   PictureFile = CurrentProject.Path & "\" & myfolder & "\" & Me.number & Trim(Str(intPages)) & ".jpg"


Ret = TWAIN_AcquireToFilename(Me.hwnd, PictureFile)


     ContScan = MsgBox("? ÍÝÙ ÕæÑÉ ÇÎÑì ", vbQuestion + vbYesNo, "ÊäÈíÉ")
    If ContScan = vbNo Then
        blnContScan = False
    End If

Loop