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
[\CODE]
_________________________
Ashok
