Selasa, 05 September 2017

RE: [MS_AccessPros] Scanin in Access It almost works!!

 

Hi Art

It looks like you are opening the report and then closing it before you output the PDF:

DoCmd.OpenReport RptName, acViewReport, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF

I suggest you switch the second and third lines.

Best wishes,
Graham

 

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 6 September 2017 08:09
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Scanin in Access It almost works!!

 

 

I Found the following procedure called scandocs():

Public Sub ScanDocs()
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Dim strFileName As String
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 i As Integer
Dim blnContScan As Boolean
Dim ContScan As String    'msgbox to chk if more pages are to be scanned
Dim PdfOverwrite As String        'msgbox to confirm pdf file overwite
Dim FSO As New FileSystemObject
Dim strFilePDF As String
Dim RptName As String
Dim strProcName As String
strProcName = "ScanDocs"

On Error GoTo Handle_Err


'empty the scantemp table
DoCmd.SetWarnings False
DoCmd.RunSQL "delete from scantemp"
DoCmd.SetWarnings True

strFileName = strDocType

'create a temp folder if it does not exists
CreateTempFolder
'if a temp folder is present, delete all files from it
DeleteFiles

'Code for scanning
'Must include reference to Microsoft Windows Image Acquisition 2.0 dll

blnContScan = True
intPages = 0
Do While blnContScan = True
    DPI = 200
    PP = 1 'No of pages
    Set Scanner = Dialog1.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False)

    With Scanner.Items(1)
        .Properties("6146").Value = 1 'Colour intent (1 for color, 2 for grayscale, 4 for b & w)
        .Properties("6147").Value = DPI 'DPI horizontal
        .Properties("6148").Value = DPI 'DPI vertical
        .Properties("6149").Value = 0 'x point to start scan
        .Properties("6150").Value = 0 'y point to start scan
        .Properties("6151").Value = 8.27 * DPI 'Horizontal extent
        .Properties("6152").Value = 11.69 * DPI     'Vertical extent for letter
    End With

    Set img = Dialog1.ShowTransfer(Scanner.Items(1), wiaFormatJPEG, True)
    'Set img = Scanner.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)

    intPages = intPages + 1
    strFileJPG = strTempFolder & "\" & strFileName & Trim(Str(intPages)) & ".jpg"

'    If FSO.FileExists(strFileJPG) Then
'        FSO.DeleteFile (strFileJPG)
'    End If
'    Set FSO = Nothing

    img.SaveFile (strFileJPG)

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

    Set Scanner = Nothing
    Set img = Nothing
    strFileJPG = ""

    'Prompt user if there are additional pages to scan
    ContScan = MsgBox("Scan another page?", vbQuestion + vbYesNo, "Continue...?")
    If ContScan = vbNo Then
        blnContScan = False
    End If

Loop

GoTo StartPDFConversion

StartPDFConversion:
    strFilePDF = strTempFolder & "\" & strFileName & ".pdf"

    If FSO.FileExists(strFilePDF) Then
        FSO.DeleteFile (strFilePDF)
    End If

    Set FSO = Nothing

'Now let's run an Access report called rptScan and output it to a PDF file on the network
'rptScan is an Access report whose recordsource is the scantemp table
RptName = "rptScan"
DoCmd.OpenReport RptName, acViewReport, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF

CustDocPath = strFilePDF
strFilePDF = ""

Handle_Exit:
    Exit Sub

Handle_Err:
    Select Case err.Description
        Case "The user requested a scan and there are no documents left in the document feeder."
            MsgBox "Please insert paper into the scanner.", vbCritical, "Warning"
            Resume
        Case "ID Not Found."
            MsgBox "Please check that your scanner is properly connected and powered on and try again later.", vbCritical, "Warning"
            Resume Handle_Exit
        Case "No such interface supported."
            MsgBox "Please check that your scanner is properly connected and powered on and try again later.", vbCritical, "Warning"
            Resume Handle_Exit
        Case "User cancelled."
            MsgBox "Scan cancelled by user.", vbCritical, "Warning"
            Resume Handle_Exit
        Case "The remote procedure call failed.."
            MsgBox "RPC failed. Please check scanner settings in windows.", vbCritical, "Warning"
            Resume Handle_Exit
        Case Else
            MsgBox "Oops! Something went wrong." & vbCrLf & vbCrLf & _
            "In Function:" & vbTab & strProcName & vbCrLf & _
            "Err Number: " & vbTab & err.Number & vbCrLf & _
            "Description: " & vbTab & err.Description, vbCritical, _
            "Error in " & Chr$(34) & strProcName & Chr$(34)
            Resume Handle_Exit
    End Select

End Sub

 

And it works perfectly, the scanner kicks does it thing for as many pages as you tell it to. There are called to other procs which I have and they work. The one thing that is killing me is at very end it blows up by not opening the PDF file as it did in the test database that I found. It reports The OutPutTo action was cancelled. Debugging it I get to this line.

 

DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF

 

Before it errors out. When you run the test database it ends up opening it up in Acrobat. And yes I have that installed..

 

It so close, any insights would be great at this time.

 

Thank you,

 

Art Lorenzini

SD

__._,_.___

Posted by: "Graham Mandeno" <graham@mandeno.com>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (2)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar